home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / BBS_UTIL / BM0406_A.ZIP / 0406.ZIP / RBBSSUB7.NEW < prev    next >
Text File  |  1994-04-06  |  130KB  |  2,852 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB7.BAS 17.5, Copyright 1986 - 94 by D. Thomas Mack'
  3. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB7.BAS
  5. '  First Released .....: November 15, 1993
  6. '  Subsequent Releases.:
  7. '  Copyright ..........: 1986 - 1994
  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-7 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. '  AddLink       63620  Adds a conference link
  18. '  ANSIChat       1000  Vertical Split Screen SysOp ANSI Chat Routine
  19. '  AraAllCaps    63720  Capitalize an elment of an array
  20. '  AskItems      63610  Get an list of items
  21. '  BadName       20235  Check for system crash attempt with bad file name
  22. '  BinSearch     63520  Binary searches sorted file for a key value
  23. '  BufAsUnit     63440  Buffer out a string with CR's
  24. '  ChangeInt     63590  Get an integer value                        ' KG01802
  25. '  CheckRatio    20096  Test upload/download ratio
  26. ' ChkIfMsgHeader 63550  Checks whether record is a msg header
  27. '  ChkMsgName    63540  Match Name to one in message file
  28. '  ClearScrn       7000  Clears screen using ANSI                    ' RM03049401
  29. 'ClearLocalLower   7400  Clears SysOp side lower half of split screen chat ' RM03049401
  30. 'ClearLocalUpper   7200  Clears SysOp side upper half of split screen chat ' RM03049401
  31. 'ClearRemoteLower  7300  Clears user side lower half of split screen chat ' RM03049401
  32. 'ClearRemoteUpper  7100  Clears user side upper half of split screen chat ' RM03049401
  33. 'CmdStackPushPop 63500  Save/Restore command stack
  34. '  CurLocate       7500  Moves cursor using ANSI codes               ' RM03049401
  35. '  Decorate        2000  Sets up screen for SysOp Split Screen Chat  ' RM03049401
  36. '  DeLink        63620  Removes conference from linked ones
  37. '  DispUserRec   63580  Displays user record
  38. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  39. '  DoorInfo      10991  Writes out information for a door
  40. '  DosExit       10935  Set up a .BAT file to exit to DOS (second level)
  41. '  ExcludeCount  63715  Counts # of words in a string
  42. '  FileNameCheck 20240  Matches file name to a prefix & extension
  43. '  FindIt        63490  Check whether file exists and if so open as #2
  44. '  FormRead      63420  Read from file into a form
  45. '  GetArc        20140  Handle request for verbose listing
  46. '  GetFastFile   63750  Sets the Fast File Tabs List'                ' RM03269401
  47. 'LocalScreenWrite  4000  Writes to SysOp side of split screen chat   ' RM03049401
  48. '  LockAppend    63400  Prepare for a file append
  49. '  LogError      13660  Log error message to CALLERS file
  50. '  MacroExe      63460  Execute internal macro rather than user
  51. '  MarkItems     63600  Convert list of items into a "mark"
  52. '  MsgNameMatch  63540  Match name to one in msg header
  53. '  NextConf      63615  Sets up join to next conference link
  54. '  NoPath        63480  Detects whether string has a path in it
  55. '  PauseExit     63465  Forces a keyboard pause inside a Macro
  56. '  PersonalRing  20350  Detects "Distinctive Ring" patterns from Phone Co. 'JR070101
  57. '  QuickPeek     20340  Easy find user to send message to            ' PEEK174
  58. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  59. '  ReadParms     63490  Read certain number of parameters from file 2
  60. '  ReadXfer      85000  subroutine to read the XFER-?.DEF File       ' DGS090601-DS
  61. '  RecoverMsg    10410  Recover a deleted message
  62. 'RemoteScreenWrite 3000 Writes to user side of split screen chat     ' RM03049401
  63. '  ReportEcho    63635  Reports echo preference of caller
  64. '  ResetRegDate  63585  Checks proposed new registration date
  65. '  SayWelcome    63640  Welcomes callers on logon
  66. '  SelectCD      63800  Select Which CD to display                   ' RM03239401
  67. '  SetBPS        20245
  68. '  SetGlobalUpDn 63675  Sets Global user stats
  69. '  SetPrivileges 63650  Sets user privileges based on PASSWRDS
  70. '  SetPrompt     63470  Set prompts based on the user's security
  71. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  72. ' SetSessionTime 63645  Sets the session time
  73. '  SetSysOp      63625  Determines whether remote or global SysOp
  74. '  SetUserFlag   63560  Sets specified user flag
  75. '  SetUserPref   63630  Sets user preferences based on user record
  76. '  SetUserUpDn   63675  Sets user's upload/download/bank time stats
  77. '  ShellExit     63320  Exit RBBS via shell
  78. '  SrchPasswrds  63652  Searches the PASSWRDS file
  79. '  SysOpVChat      5000  Split Screen Chat                           ' RM03049401
  80. '  TakeOffHook   63530  Take modem off hook
  81. '  TestANSI      63700  Tests caller for ANSI compatibility
  82. '  TimeBack      63495  Give time back to user
  83. '  UnLockAppend  63410  Clean up after file append
  84. '  UnMarkItems   63610  Convert marked items into an input list
  85. '  UntilRight    12878  Ask a question until user says answer is right
  86. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  87. '  VerifyAns     63510  Verify that string passes edits
  88. '  WildCard      63200  Match string to a pattern
  89. '  WordInFile    10976  Find a whole word within a file/menu
  90. '
  91. '  $INCLUDE: 'RBBS-VAR.BAS'
  92. '
  93. ' $SUBTITLE: 'ANSIChat - Vertical Split Screen SysOp ANSI Chat Routine'
  94. '
  95. ' $PAGE
  96. '
  97. ' ANSIChat Vertical Split Screen Chat for RBBS-PC v17.4x'
  98. '
  99. '          (c) 1991,1992,1993 By Richie Molinelli
  100. '
  101. '
  102. '  SUBROUTINE NAME    -  ANSIChat
  103. '
  104. '             INPUT   -  None
  105. '
  106. '             OUTPUT  -  None
  107. '
  108. '  PURPOSE -- Allows Vertical Split Screen ANSI SysOp Chat for RBBS
  109. '
  110. '
  111. 1000 SUB ANSIChat                      ' Main program                ' RM03299401
  112.      CALL ClearScrn
  113.      CALL Decorate
  114.      CALL SysopVChat
  115.      IF ZSubParm < 0 THEN _            ' RM12189303
  116.         EXIT SUB                       ' RM12189303
  117.      CALL ClearScrn
  118.      CALL SkipLine (1)
  119.      END SUB
  120. '
  121. 2000 SUB Decorate                      ' Sets up the screen for chat ' RM03299401
  122.      ScreenTxt$ = STRING$(78,177)
  123.      CALL CurLocate (1,1)
  124.      CALL QuickTPut (ZFG6$ + ScreenTxt$,0)
  125.      CALL CurLocate (24,1)
  126.      CALL QuickTput (ScreenTxt$,0)
  127.      CALL CurLocate (1,1)
  128.      CALL QuickTPut (ZEmphasizeOn$ + "ANSIChat v1.5ß",0)             ' RM10109301/RM03049401
  129.      OutTxt$ =  " >>> " +  ZRBBSName$ + " <<< "                      ' RM100101
  130.      LocalColumn = 40 - (LEN(OutTxt$)/2)                             ' RM100101
  131.      CALL CurLocate (1,LocalColumn)
  132.      CALL QuickTPut (OutTxt$,0)                                      ' RM100101
  133.      CALL CurLocate (1,60)
  134.      CALL QuickTPut ("(c) 1992 R Molinelli",0)
  135.      Column = 40
  136.      CALL QuickTPut (ZFG5$,0)
  137.      FOR Row = 2 TO 23
  138.         CALL CurLocate (Row,Column) : _
  139.         CALL QuickTPut(STRING$(1,186),0) : _
  140.      NEXT Row
  141.      OutTxt$ = ZSysopFirstName$ + " " + ZSysopLastName$              ' RM100101
  142.      LocalColumn = (40 - LEN(OutTxt$))/2                             ' RM100101
  143.      CALL CurLocate (24,LocalColumn)
  144.      CALL QuickTPut (ZEmphasizeOn$ + OutTxt$,0)                      ' RM100101
  145.      LocalColumn = 40 + ((40 - LEN(ZActiveUserName$))/2)
  146.      CALL CurLocate (24,LocalColumn)
  147.      CALL QuickTPut (ZActiveUserName$ + ZEmphasizeOff$,0)
  148.      CALL Line25
  149.      CALL CurLocate (2,1)
  150.      END SUB
  151. '
  152. 3000 SUB RemoteScreenWrite (RemoteTxt$,RemoteRow,RemoteColumn,Bs) STATIC  ' Writes Remote Users Input
  153.      BackSpace = ZFalse                                              ' RM10109302
  154.      IF HoldRTxt$ <> "" AND Bs = 1 THEN _
  155.         HoldRTxt$ = MID$(HoldRTxt$,1,LEN(HoldRTxt$) - 1)
  156.      IF Bs = 1 THEN _
  157.         RemoteColumn = RemoteColumn - 1 : _
  158.         RemoteTxt$ = " " : _
  159.         BackSpace = ZTrue : _                                        ' RM10109302
  160.         GOSUB 3010 : _
  161.         Bs = 0 : _
  162.         GOTO 3020
  163.      IF LEN(HoldRTxt$) => 38 THEN
  164.         HoldRTxt$ = ""
  165.         RemoteColumn = 42
  166.         RemoteRow = RemoteRow + 1
  167.         IF RemoteRow > 23 THEN _
  168.            CALL ClearRemoteUpper : _
  169.            RemoteRow = 2
  170.         CALL CurLocate (RemoteRow,RemoteColumn)
  171.      END IF
  172.      IF RemoteTxt$ <> " " THEN _
  173.         HoldRTxt$ = HoldRTxt$ + RemoteTxt$ _
  174.      ELSE _
  175.         HoldRTxt$ = ""
  176.      IF RemoteColumn > 78 AND RemoteTxt$ = " " THEN
  177.         RemoteColumn = 42
  178.         RemoteRow = RemoteRow + 1
  179.         IF RemoteRow = 12 THEN _
  180.            CALL ClearRemoteLower
  181.         IF RemoteRow > 23 THEN _
  182.            CALL ClearRemoteUpper : _
  183.            RemoteRow = 2
  184.         CALL CurLocate (RemoteRow,RemoteColumn)
  185.         RemoteTxt$ = ""
  186.         HoldRTxt$ = ""
  187.         EXIT SUB
  188.      END IF
  189.      IF RemoteColumn > 79 AND RemoteTxt$ <> " " THEN
  190.         RemoteColumn = 80 - LEN(HoldRTxt$)
  191.         HoldCTxt$ = STRING$((LEN(HoldRTxt$) + 1),32)
  192.         CALL CurLocate (RemoteRow,RemoteColumn)
  193.         CALL QuickTPut (HoldCTxt$,0)
  194.         RemoteColumn = 42
  195.         RemoteRow = RemoteRow + 1
  196.         IF RemoteRow = 12 THEN _
  197.            CALL ClearRemoteLower
  198.         IF RemoteRow > 23 THEN _
  199.            CALL ClearRemoteUpper : _
  200.            RemoteRow = 2
  201.         CALL CurLocate (RemoteRow,RemoteColumn)
  202.         CALL QuickTPut (ZFG2$ + HoldRTxt$,0)
  203.         RemoteColumn = RemoteColumn + LEN(HoldRTxt$)
  204.         CALL CurLocate (RemoteRow,RemoteColumn)
  205.         ZRemoteTxt$ = ""
  206.         EXIT SUB
  207.      END IF
  208. 3010 CALL CurLocate (RemoteRow,RemoteColumn)
  209.      IF BackSpace THEN _                                             ' RM10109302
  210.         CALL QuickTPut (RemoteTxt$,0) _                              ' RM10109302
  211.      ELSE _                                                          ' RM10109302
  212.         CALL QuickTPut (ZFG2$ + RemoteTxt$,0)
  213.      IF Bs > 0 THEN _
  214.         CALL CurLocate (RemoteRow,RemoteColumn) : _
  215.         RETURN
  216.      RemoteColumn = RemoteColumn + LEN(RemoteTxt$)
  217. 3020 RemoteTxt$ = ""
  218.      END SUB
  219. '
  220. 4000 SUB LocalScreenWrite (LocalTxt$,LocalRow,LocalColumn,Bs) STATIC      ' Writes Local Users Input
  221.      BackSpace = ZFalse                                              ' RM10109302
  222.      IF HoldLTxt$ <> "" AND Bs = 1 THEN _
  223.         HoldLTxt$ = MID$(HoldLTxt$,1,LEN(HoldLTxt$) - 1)
  224.      IF Bs = 1 THEN _
  225.         LocalColumn = LocalColumn - 1 : _
  226.         BackSpace = ZTrue : _                                        ' RM10109302
  227.         LocalTxt$ = " " : _
  228.         GOSUB 4010 : _
  229.         Bs = 0 : _
  230.         GOTO 4020
  231.      IF LEN(HoldLTxt$) => 38 THEN
  232.         HoldLTxt$ = ""
  233.         LocalColumn = 1
  234.         LocalRow = LocalRow + 1
  235.         IF LocalRow > 23 THEN _
  236.            CALL ClearLocalUpper : _
  237.            LocalRow = 2
  238.         CALL CurLocate (LocalRow,LocalColumn)
  239.      END IF
  240.      IF LocalTxt$ <> " " THEN _
  241.         HoldLTxt$ = HoldLTxt$ + LocalTxt$ _
  242.      ELSE _
  243.         HoldLTxt$ = ""
  244.      IF LocalColumn > 37 AND LocalTxt$ = " " THEN
  245.         LocalColumn = 1
  246.         LocalRow = LocalRow + 1
  247.         IF LocalRow = 12 THEN _
  248.            CALL ClearLocalLower
  249.         IF LocalRow > 23 THEN _
  250.            CALL ClearLocalUpper : _
  251.            LocalRow = 2
  252.         CALL CurLocate (LocalRow,LocalColumn)
  253.         LocalTxt$ = ""
  254.         HoldLTxt$ = ""
  255.         EXIT SUB
  256.      END IF
  257.      IF LocalColumn > 38 AND LocalTxt$ <> " " THEN
  258.         LocalColumn = 39 - LEN(HoldLTxt$)
  259.         HoldCTxt$ = STRING$((LEN(HoldLTxt$) + 1),32)
  260.         CALL CurLocate (LocalRow,LocalColumn)
  261.         CALL QuickTPut (HoldCTxt$,0)
  262.         LocalColumn = 1
  263.         LocalRow = LocalRow + 1
  264.         IF LocalRow = 12 THEN _
  265.            CALL ClearLocalLower
  266.         IF LocalRow > 23 THEN
  267.            CALL ClearLocalUpper : _
  268.            LocalRow = 2
  269.         END IF
  270.         CALL CurLocate (LocalRow,LocalColumn)
  271.         CALL QuickTPut (ZFG4$ + HoldLTxt$,0)
  272.         LocalColumn = LocalColumn + LEN(HoldLTxt$)
  273.         CALL CurLocate (LocalRow,LocalColumn)
  274.         LocalTxt$ = ""
  275.         EXIT SUB
  276.      END IF
  277. 4010 CALL CurLocate (LocalRow,LocalColumn)
  278.      IF BackSpace THEN _                                             ' RM10109302
  279.         CALL QuickTPut (LocalTxt$,0) _                               ' RM10109302
  280.      ELSE _                                                          ' RM10109302
  281.         CALL QuickTPut (ZFG4$ + LocalTxt$,0)
  282.      IF Bs > 0 THEN _
  283.         CALL CurLocate (LocalRow,LocalColumn) : _
  284.         RETURN
  285.      LocalColumn = LocalColumn + LEN(LocalTxt$)
  286. 4020 LocalTxt$ = ""
  287.      END SUB
  288. '
  289.      SUB SysopVChat                      ' Verticl SysOp ANSI Chat routine ' RM03309401
  290. 5000 LocalColumn = 1
  291.      LocalRow = 2
  292.      RemoteColumn = 42
  293.      RemoteRow = 2
  294.      LocalTxt$ = "Hi, " + ZFirstName$ + ".  Go Ahead..."
  295.      CALL LocalScreenWrite (LocalTxt$,LocalRow,LocalColumn,0)        ' RM03049401
  296.      LocalColumn = 1                                                 ' RM03049401
  297.      LocalRow = 4                                                    ' RM03049401
  298.      HoldLTxt$ = ""
  299.      HoldRTxt$ = ""
  300.      HoldCTxt$ = ""
  301.      CALL CurLocate (RemoteRow,RemoteColumn)
  302.      ZWaitExpired = ZFalse
  303. 5010 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  304.      CALL Carrier
  305.      IF ZSubParm < 0 THEN _
  306.         EXIT SUB
  307.      CALL GoIdle                                                     ' RM102993
  308. 5020 CALL FindFKey
  309.      IF ZSubParm < 0 THEN _                                          ' RM12189303
  310.         EXIT SUB                                                     ' RM12189303
  311.      IF ZWasCM = 0 THEN _
  312.         CALL FlushCom (ZCommPortStack$) : _
  313.         ZKeyPressed$ = "" : _
  314.         ZWasCM = ZTrue : _
  315.         GOTO 5010
  316.      LocalTxt$ = ZKeyPressed$
  317.      IF ZKeyPressed$ = ZEscape$ THEN _
  318.         EXIT SUB
  319.      IF LocalTxt$ = "" THEN _
  320.         GOTO 5030
  321.      IF LocalTxt$ = CHR$(8) THEN _
  322.         GOTO 5070 _
  323.      ELSE IF LocalTxt$ = CHR$(9) THEN _
  324.         GOTO 5090 _
  325.      ELSE IF LocalTxt$ = CHR$(13) THEN _
  326.         GOTO 6010
  327.      CALL LocalScreenWrite (LocalTxt$,LocalRow,LocalColumn,0)
  328.      GOTO 5010
  329. 5030 IF ZLocalUser THEN _
  330.         GOTO 5010
  331.      IF ZCommPortStack$ <> "" THEN _
  332.         RemoteTxt$ = LEFT$(ZCommPortStack$,LEN(ZCommPortStack$) - 1) : _
  333.         CALL RemoteScreenWrite (RemoteTxt$,RemoteRow,RemoteColumn,0)
  334.      CALL EofComm (Char)
  335.      IF Char <> -1 THEN _
  336.         GOTO 5050 _
  337.      ELSE _
  338.         GOTO 5010
  339. 5050 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  340.      CALL GetCom (RemoteTxt$)
  341.      IF RemoteTxt$ = CHR$(8) THEN _
  342.         GOTO 6030 _
  343.      ELSE IF RemoteTxt$ = CHR$(9) THEN _
  344.         GOTO 6050 _
  345.      ELSE IF RemoteTxt$ = CHR$(13) THEN _
  346.         GOTO 6070
  347.      CALL RemoteScreenWrite (RemoteTxt$,RemoteRow,RemoteColumn,0)
  348.      GOTO 5010
  349. 5070 IF LocalColumn - 1 > 0 THEN _     ' Local Back Space
  350.         CALL LocalScreenWrite (LocalTxt$,LocalRow,LocalColumn,1)
  351.      GOTO 5010
  352. 5090 IF LocalColumn + 5 > 38 AND LocalRow < 24 THEN _ 'Local TAB
  353.         LocalColumn = 38 _
  354.      ELSE _
  355.         LocalColumn = LocalColumn + 4
  356.      LocalTxt$ = " "
  357.      CALL LocalScreenWrite (LocalTxt$,LocalRow,LocalColumn,0)
  358.      GOTO 5010
  359. 6010 LocalColumn = 38                  ' Local Carriage Return
  360.      LocalTxt$ = " "
  361.      CALL LocalScreenWrite (LocalTxt$,LocalRow,LocalColumn,0)
  362.      GOTO 5010
  363. 6030 IF RemoteColumn - 1 > 41 THEN _   ' Remote Back Space
  364.         CALL RemoteScreenWrite (RemoteTxt$,RemoteRow,RemoteColumn,1)
  365.      GOTO 5010
  366. 6050 IF RemoteColumn + 5 > 79 AND RemoteRow < 24 THEN _  ' Remote TAB
  367.         RemoteColumn = 79 _
  368.      ELSE _
  369.         RemoteColumn = RemoteColumn + 4
  370.      RemoteTxt$ = " "
  371.      CALL RemoteScreenWrite (RemoteTxt$,RemoteRow,RemoteColumn,0)
  372.      GOTO 5010
  373. 6070 RemoteColumn = 79                 ' Remote Carriage Return
  374.      RemoteTxt$ = " "
  375.      CALL RemoteScreenWrite (RemoteTxt$,RemoteRow,RemoteColumn,0)
  376.      GOTO 5010
  377.      END SUB
  378. '
  379. 7000 SUB ClearScrn                     ' Clears the Entire screen    ' RM03299401
  380.      CALL QuickTPut ("",0)
  381.      ZSubParm = 2
  382.      CALL Line25
  383.      ZSubParm = 0
  384.      CALL CurLocate (1,1)
  385.      END SUB
  386. '
  387. 7100 SUB ClearRemoteUpper              ' Clears the Upper half of Remote users screen ' RM03299401
  388.      Column = 42
  389.      FOR Row = 2 TO 13
  390.          CALL CurLocate (Row,Column)
  391.          CALL QuickTPut ("",0)
  392.      NEXT Row
  393.      END SUB
  394. '
  395. 7200 SUB ClearLocalUpper               ' Clears the Upper half of Local users screen ' RM03299401
  396.      Column = 1
  397.      FOR Row = 2 TO 13
  398.         CALL CurLocate (Row,Column)
  399.         CALL QuickTPut (STRING$(38,32),0)
  400.      NEXT Row
  401.      END SUB
  402. '
  403. 7300 SUB ClearRemoteLower              ' Clears the lower half of Remote users Screen ' RM03299401
  404.      Column = 42
  405.      FOR Row = 14 TO 23
  406.         CALL CurLocate (Row,Column)
  407.         CALL QuickTPut ("",0)
  408.      NEXT Row
  409.      END SUB
  410. '
  411. 7400 SUB ClearLocalLower                ' Clears the lower half of Local users screen ' RM03299401
  412.      Column = 1
  413.      FOR Row = 14 TO 23
  414.         CALL CurLocate (Row,Column)
  415.         CALL QuickTPut (STRING$(38,32),0)
  416.      NEXT Row
  417.      END SUB
  418. '
  419. 7500 SUB CurLocate (Row,Column)          ' Moves the cursor to desired position ' RM03299401
  420.      CALL QuickTPut ("" + MID$(STR$(Row),2) + ";" + MID$(STR$(Column),2) + "H",0)
  421.      END SUB
  422. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  423. ' $PAGE
  424. '
  425. '  NAME    -- RecoverMsg
  426. '
  427. '  INPUTS  --     PARAMETER                    MEANING
  428. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  429. '              ZFirstMsgRecord        RECORD # FOR First MSG         ' RM08119301
  430. '
  431. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  432. '                                         SET TO -1 IF No ERROR
  433. '
  434. '  PURPOSE --  To recover deleted messages.  Note that this is only
  435. '              possible if you have not compressed your message file
  436. '              using config.
  437. '
  438.       SUB RecoverMsg (MsgToRecover,ActionFlag) STATIC                ' RM08119301
  439.       FIELD #1,128 AS ZMsgRec$
  440.       MsgRec = ZFirstMsgRecord                                       ' RM08119301
  441. 10420 GET 1,MsgRec
  442.       NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
  443.       IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
  444.          ZWasY$ = "No Msg #" + _
  445.               STR$(MsgToRecover) : _
  446.          GOTO 10485
  447. 10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _
  448.          MsgRec = MsgRec + NumRecsInMsg : _
  449.          GOTO 10420
  450. 10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
  451.          LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
  452.                                 ZActiveMessage$ + _
  453.                                 MID$(ZMsgRec$,117) : _
  454.          PUT 1,LOC(1) : _
  455.          ZWasY$ = "Restored Msg #" + _
  456.               STR$(MsgToRecover) : _
  457.          ActionFlag = ZTrue : _
  458.          GOTO 10485
  459. 10480 ZWasY$ = "Msg #" + _
  460.            STR$(MsgToRecover) + _
  461.            " not Dead"
  462. 10485 CALL QuickTPut1 (ZWasY$)
  463.       END SUB
  464. 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff'
  465. ' $PAGE
  466. '  NAME    -- UpdateU
  467. '
  468. '  INPUTS  -- PARAMETER             MEANING
  469. '             ZAdjustedSecurity
  470. '             ZCurDate$
  471. '             ZDnlds
  472. '             ZElapsedTime
  473. '             ZListDir
  474. '             ZMainUserFileIndex
  475. '             ZSecsPerSession!
  476. '             ZUplds
  477. '             ZUserSecLevel
  478. '
  479. '  OUTPUTS -- ZElapsedTime$
  480. '             ZListNewDate$
  481. '             ZSecLevel$
  482. '             ZUserDnlds$
  483. '             ZUserUplds$
  484. '
  485. '  PURPOSE -- Update the user record for the user when the user
  486. '             exits RBBS-PC.
  487. '
  488.       SUB UpdateU (LoggingOff)                                       ' RM03309401
  489.       IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _
  490.          EXIT SUB
  491.       IF ZUserFileIndex < 1 THEN _
  492.          GOTO 10607
  493.       UpdateDefaults = ZTrue
  494. 10602 ZSubParm = 6
  495.       ZWasY$ = ZLastDateTimeOn$
  496.       CALL FileLock
  497.       CALL OpenUser (ZHighestUserRecord)
  498.       FIELD 5,31 AS ZUserName$, _
  499.               15 AS ZPswd$, _
  500.                2 AS ZSecLevel$, _
  501.               14 AS ZUserOption$,  _
  502.               24 AS ZCityState$, _
  503.                1 AS MachineType$, _                                  ' DROP174
  504.                1 AS ZDropTimes$, _                                   ' DROP174
  505.                1 AS ZBankTime$,_
  506.                4 AS ZTodayDl$, _
  507.                4 AS ZTodayBytes$, _
  508.                4 AS ZDlBytes$, _
  509.                4 AS ZULBytes$, _
  510.               14 AS ZLastDateTimeOn$, _
  511.                3 AS ZListNewDate$, _
  512.                2 AS ZUserDnlds$, _
  513.                2 AS ZUserUplds$, _
  514.                2 AS ZElapsedTime$
  515. 10604 GET 5,ZUserFileIndex
  516.       IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
  517.          ZUplds = ZGlobalUplds : _
  518.          ZDnlds = ZGlobalDnlds : _
  519.          ZDLToday! = ZGlobalDLToday! : _
  520.          ZBytesToday! = ZGlobalBytesToday! : _
  521.          ZDLBytes! = ZGlobalDLBytes! : _
  522.          ZULBytes! = ZGlobalULBytes! : _
  523.          ZDropTimes = ZGlobalDropTimes : _                           ' DROP174
  524.          ZBankTime = ZGlobalBankTime _
  525.       ELSE ZBankTime = 0
  526.       LSET ZBankTime$ = CHR$(ZBankTime)
  527.       LSET ZDropTimes$ = CHR$(ZDropTimes)                            ' DROP174
  528.       LSET ZLastDateTimeOn$ = ZWasY$
  529.       LSET ZCityState$ = ZWasCI$
  530.       IF UpdateDefaults THEN _
  531.          CALL DefaultU
  532.       IF ZListDir THEN _
  533.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  534.                               CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  535.                               CHR$(VAL(MID$(ZCurDate$,4,2)))
  536. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  537.       LSET ZUserUplds$ = MKI$(ZUplds)
  538.       IF ZEnforceRatios THEN _
  539.          LSET ZTodayDl$ = MKS$(ZDLToday!) : _
  540.          LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _
  541.          LSET ZDlBytes$ = MKS$(ZDLBytes!) : _
  542.          LSET ZULBytes$ = MKS$(ZULBytes!)
  543.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  544.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  545.          TempElapsed! = ZElapsedTime + _
  546.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  547.          ZTimeCredits! = 0 _
  548.       ELSE TempElapsed! = ZElapsedTime - ZExitToDoors*ZMinsInDoors
  549.       IF TempElapsed! < -32767 THEN _
  550.          TempElapsed! = -32767 _
  551.       ELSE IF TempElapsed! > 32767 THEN _
  552.          TempElapsed! = 32767
  553.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  554.       IF ZAdjustedSecurity THEN _
  555.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  556.       PUT 5,ZUserFileIndex
  557.       ZSubParm = 8
  558.       CALL FileLock
  559.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  560.          ZActiveUserFile$ = ZOrigUserFile$ : _
  561.          ZUserFileIndex = ZOrigUserFileIndex : _
  562.          UpdateDefaults = ZFalse : _
  563.          ZAdjustedSecurity = ZFalse : _                              ' KG022502
  564.          LSET ZLastDateTimeOn$ = ZOrigDateTimeOn$ : _
  565.          GOTO 10602
  566. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  567.          EXIT SUB
  568.       Temp = ZMinsPerSession
  569.       IF ZMaxPerDay > 0 THEN _
  570.          Temp = ZMaxPerDay - TempElapsed! : _
  571.          IF Temp > ZMinsPerSession THEN _
  572.             Temp = ZMinsPerSession
  573.       Temp = -(Temp > 0) * Temp
  574.       CALL QuickTPut1 (ZFG5$ + "You have " + ZFG7$ + STR$(Temp) + ZFG5$ + _
  575.                " minutes left for next call today" + ZEmphasizeOff$) ' RM051701/RM12169301
  576.       IF ZTimeBankInActive <> 1 AND ZMaxBank > 0 THEN _                ' RM12169301
  577.          CALL QuickTPut1 (ZFG5$ + "and " + ZFG7$ + STR$(ZGlobalBankTime) + _ ' BANK174
  578.                        ZFG5$ + " Minutes Banked Time." + ZEmphasizeOff$)
  579.       CALL SkipLine (1)                                              ' RM051901
  580.       CALL QuickTPut1 (ZFG7$ + ZFirstName$ + ZFG5$ + ", Thanks for calling " + ZFG7$ + ZRBBSName$ + _
  581.                        ZFG5$ + " and please call again!" + ZColorReset$) ' RM051701/RM09269301
  582.       IF NOT ZHiLiteOff THEN _
  583.          CALL QuickTPut1 (ZColorReset$)
  584.       CALL DelayTime (8 + ZBPS)
  585.       IF ZOrigUserName$ = ZSecretName$ THEN                          ' MENU174  Moved from RBBS-PC.BAS
  586.          ZMenuNewDate$ = LEFT$(DATE$,6) + RIGHT$(DATE$,2)            ' MENU174  to save space
  587.          ZMenuNewTime$ = LEFT$(TIME$,5)                              ' MENU174
  588.          ZMenuNewUpld = 0                                            ' MENU174
  589.          ZMenuNewUsers = 0                                           ' MENU174
  590.          ZMenuNewCalls = 0                                           ' MENU174
  591.          ZMenuNewSysop = 0                                           ' MENU174
  592. '        CALL RingCaller                                             ' MENU174 Uncomment if you want to ring bell when signing off!
  593.          CALL QuickTPut1 (ZFG1$ + "SYSOP New Stats Reset." + ZColorReset$) ' MENU174/RM10119302
  594.          ZOutTxt$ = ""                                               ' MENU174
  595.       END IF                                                         ' MENU174
  596.       CALL OpenOutW (ZNodeWorkDrvPath$ + "MNEW" + ZNodeID$ + ".DEF") ' MENU174/RM08079301
  597.       CALL PrintWorkA (ZMenuNewDate$)
  598.       CALL PrintWorkA (ZMenuNewTime$)
  599.       CALL PrintWorkA (STR$(ZMenuNewUpld))
  600.       CALL PrintWorkA (STR$(ZMenuNewUsers))
  601.       CALL PrintWorkA (STR$(ZMenuNewCalls))
  602.       CALL PrintWorkA (STR$(ZMenuNewSysop))
  603.       CLOSE 2                                                        ' MENU174/RM100601
  604.       END SUB
  605. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  606. ' $PAGE
  607. '  NAME    -- DosExit
  608. '
  609. '  INPUTS  -- PARAMETER             MEANING
  610. '             ZComPort$
  611. '             ZDoorsTermType
  612. '             ZMultiLinkPresent
  613. '             ZRBBSBat$
  614. '             ZRedirectIOMethod
  615. '             ZUseDeviceDriver$
  616. '
  617. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  618. '                                      ZRCTTYBat$
  619. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  620. '
  621. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  622. '             exit to DOS for the remote RBBS-PC sysop
  623. '
  624.       SUB DosExit                                                    ' RM03309401
  625.       IF ZMultiLinkPresent AND _
  626.          ZDoorsTermType > 0 THEN _
  627.          ZFF = 0 : _
  628.          GOTO 10950
  629.       ZOutTxt$(1) = "ECHO OFF"
  630.       IF ZUseDeviceDriver$ <> "" THEN _
  631.          Port$ = ZUseDeviceDriver$ _
  632.       ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
  633.       IF ZRedirectIOMethod THEN _
  634.          ZFF = 5 : _
  635.          ZOutTxt$(2) = "CTTY " + _
  636.                  Port$ : _
  637.          ZOutTxt$(3) = ZDiskForDos$ + _
  638.                  "COMMAND" : _
  639.          ZOutTxt$(4) = "CTTY CON" : _
  640.          ZOutTxt$(5) = ZRBBSBat$ _
  641.       ELSE ZFF = 3 : _
  642.            ZOutTxt$(2) = ZDiskForDos$ + _
  643.                    "COMMAND >" + _
  644.                    Port$ + _
  645.                    " <" + _
  646.                    Port$ : _
  647.            ZOutTxt$(3) = ZRBBSBat$
  648. 10950 CALL AMorPM
  649.       CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  650.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  651.       CALL QuickTPut1 ("SysOp in Remote Console mode")
  652.       CALL RBBSExit (ZOutTxt$(),ZFF)
  653.       END SUB
  654. 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word'
  655. ' $PAGE
  656. '  NAME    -- WordInFile
  657. '
  658. '  INPUTS  -- PARAMETER             MEANING
  659. '             FilName$              FILE TO SEARCH IN
  660. '             Strng$                STRING TO SEARCH FOR
  661. '
  662. '  OUTPUTS -- InFile                WHETHER STRING Found IN FILE
  663. '
  664. '  PURPOSE -- Searches for "Strng$" in file "FILNAME$."  Used to
  665. '             limit doors and questionnaires to those specified
  666. '             in their menu files.  The "Strng$" is capitalized
  667. '             but not the lines in the file, so must be exact
  668. '             case-sensitive match to be found.  The only character
  669. '             that can immediately proceed or end a name to be
  670. '             found must be a blank.
  671. '
  672.       SUB WordInFile (FilName$,Strng$,InFile) STATIC
  673.       InFile = ZFalse
  674.       CALL FindIt (FilName$)
  675.       IF NOT ZOK THEN _
  676.          EXIT SUB
  677.       WasX = 0
  678.       CALL AllCaps (Strng$)
  679.       WHILE NOT EOF(2) AND WasX < 1
  680.          LINE INPUT #2,ZOutTxt$
  681.          WasY = 1
  682. 10978    WasX = INSTR(WasY,ZOutTxt$,Strng$)
  683.          IF WasX < 1 THEN _
  684.             GOTO 10980
  685.          WasY = WasX + 1
  686.          IF WasX > 1 THEN _
  687.             IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _
  688.                WasX = 0
  689.          IF WasX > 0 THEN _
  690.             WasL = LEN(Strng$) : _
  691.             IF LEN(ZOutTxt$) => (WasX + WasL) THEN _
  692.                IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _
  693.                   WasX = 0
  694.          IF WasX = 0 THEN _
  695.             GOTO 10978
  696. 10980 WEND
  697.       CLOSE 2
  698.       InFile = (WasX > 0)
  699.       END SUB
  700. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  701. ' $PAGE
  702. '  NAME    -- DoorExit
  703. '
  704. '  INPUTS  -- PARAMETER             MEANING
  705. '             ZMultiLinkPresent
  706. '             ZNodeID$
  707. '             ZRBBSBat$
  708. '             ZWasZ$
  709. '
  710. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  711. '                                      ZRCTTYBat$
  712. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  713. '
  714. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  715. '             exit RBBS-PC to invoke another program
  716. '
  717.       SUB DoorExit (ReqDoorsDef)                                     ' RM03309401
  718.       IF ZWasZ$ = "" OR _
  719.          ZWasZ$ = "NONE" THEN _
  720.          EXIT SUB
  721.       CALL FindIt (ZWasZ$)
  722.       IF NOT ZOK THEN _
  723.          GOTO 10986
  724.       CALL BreakFileName (ZWasZ$,WasX$,ExitTo$,ExitMethod$,ZFalse)
  725.       ExitMethod$ = ""
  726.       ZDooredTo$ = ExitTo$
  727.       CALL FindIt (ZDoorsDef$)
  728.       IF NOT ZOK THEN _
  729.          IF ReqDoorsDef THEN _
  730.             EXIT SUB _
  731.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  732.               GOTO 10989
  733. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  734.       IF ZErrCode > 0 THEN _
  735.          IF ReqDoorsDef THEN _
  736.             EXIT SUB _
  737.          ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  738.               GOTO 10989
  739.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  740.          GOTO 10985
  741.       CALL CheckInt (ZOutTxt$(2))
  742.       IF ZErrCode > 0 THEN _
  743.          ZErrCode = 0 : _
  744.          GOTO 10985
  745.       IF ZUserSecLevel < ZTestedIntValue THEN _
  746.          CALL QuickTPut1 ("Insufficient security for door") : _
  747.          EXIT SUB
  748.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  749.       CALL FindIt (WasX$)
  750.       IF NOT ZOK THEN _
  751.          GOTO 10986
  752.       ZFileName$ = ZOutTxt$(3)
  753.       ExitMethod$ = ZOutTxt$(4)
  754.       ExitTemplate$ = ZOutTxt$(5)
  755.       ZDoorDisplay$ = ZOutTxt$(7)
  756.       ZDoorTime$ = ZOutTxt$(8)
  757.       CALL AskUsers
  758.       REDIM ZUserIn$(ZMsgDim)                                        ' RM08299301
  759.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  760.       CALL MetaGSR (ExitTemplate$,ZFalse)
  761.       ExitTo$ = ExitTemplate$
  762.       GOTO 10989
  763. 10986 ZOutTxt$ = "Missing door program"
  764.       CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1)
  765.       ZSnoop = ZTrue
  766.       CALL LPrnt (ZOutTxt$,1)
  767.       EXIT SUB
  768. 10989 IF ZTransferFunction = 3 THEN _
  769.          ZWasY$ = "Registration" _
  770.       ELSE ZWasY$ = ZDooredTo$
  771.       ZOutTxt$ = ZFG7$ + ZWasY$ + _
  772.            ZFG6$ + " door opened at " + _
  773.            ZFG7$ + TIME$ + _
  774.            ZFG6$ +" on " + _
  775.            ZFG7$ + DATE$ + ZEmphasizeOff$                            ' RM051701
  776.       ZSubParm = 5
  777.       CALL TPut
  778.       CALL QuickTPut1 (ZFG7$ + "Loading Door....Please wait....." + ZEmphasizeOff$) ' RM051701
  779.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  780.       CALL DoorInfo
  781.       IF ExitMethod$ = "S" THEN _
  782.          CALL UpdateU (ZFalse) : _
  783.          CLOSE 4,5 : _
  784.          CALL ShellExit (ExitTemplate$) : _
  785.          ZPrevCaller$ = "" : _
  786.          CALL SetCall : _
  787.          ZExitToDoors = ZTrue : _
  788.          CALL DoorReturn : _
  789.          CALL BufFile (ZDoorDisplay$,WasX) : _
  790.          ZExitToDoors = ZFalse _
  791.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  792.                   "COMMAND /C " + _
  793.                   ExitTo$ : _
  794.            ZOutTxt$(2) = ZRBBSBat$ : _
  795.            CALL RBBSExit (ZOutTxt$(),2)
  796.       END SUB
  797. 10991 ' $SUBTITLE: 'DoorInfo -- Write info for doors to file'
  798.       SUB DoorInfo                                                   ' RM03309401
  799.       CLOSE 2
  800.       OPEN "O",2,"DORINFO" + _
  801.                  ZNodeFileID$ + _
  802.                  ".DEF"
  803.       PRINT #2,ZRBBSName$
  804.       PRINT #2,ZSysopFirstName$
  805.       PRINT #2,ZSysopLastName$
  806.       IF ZLocalUser THEN _
  807.          PRINT #2,"COM0" _
  808.       ELSE PRINT #2,ZComPort$
  809.       ZUserIn$ = MID$(ZBaudParity$, INSTR(ZBaudParity$, ","))
  810.       PRINT #2,ZTalkToModemAt$;" BAUD";                              ' CM0102
  811.       IF ZReliableMode THEN PRINT #2,"-R";                           ' CM0102
  812.       PRINT #2,ZUserIn$                                              ' CM0102
  813.       IF ZNetworkType = 7 THEN _                                     ' RM01109401 - MailMgr fix
  814.          NetworkType = 6 _                                           ' RM01109401 - MailMgr fix
  815.       ELSE _                                                         ' RM01109401 - MailMgr fix
  816.          NetworkType = ZNetworkType                                  ' RM01109401 - MailMgr fix
  817.       PRINT #2,NetworkType                                           ' RM01109401 - MailMgr fix
  818.       IF ZGlobalSysop THEN _
  819.          PRINT #2,"SYSOP" : _
  820.          PRINT #2,"" _
  821.       ELSE PRINT #2,OrigFirstName$ : _                               ' DGSALIAS
  822.            PRINT #2,ZLastName$
  823.       PRINT #2,ZCityState$
  824.       PRINT #2,ZWasGR
  825.       PRINT #2,ZUserSecLevel
  826.       CALL TimeRemain (MinsRemaining)
  827.       CALL CheckInt (ZDoorTime$)
  828.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  829.          IF MinsRemaining > ZTestedIntValue THEN _
  830.             MinsRemaining = ZTestedIntValue
  831.       PRINT #2,INT(MinsRemaining)
  832.       PRINT #2,ZFossil
  833.       CLOSE 2
  834.       END SUB
  835. 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS'
  836. ' $PAGE
  837. '  NAME    -- RBBSExit
  838. '
  839. '  INPUTS  -- PARAMETER             MEANING
  840. '             LINE.ARA        Array of lines to write to batch file
  841. '             NumLines        How many lines in array
  842. '
  843. '  OUTPUTS -- ZRCTTYBat$
  844. '
  845. '  PURPOSE -- To create a batch file that control can be passed to
  846. '             and to exit RBBS-PC while still keeping carrier up
  847. '
  848.       SUB RBBSExit (LineAra$(1),NumLines)                            ' RM03309401
  849.       CLOSE 2
  850.       IF NumLines = 0 THEN _
  851.          GOTO 10994
  852.       OPEN "O",2,ZRCTTYBat$
  853.       FOR WasI = 1 TO NumLines
  854.          IF LineAra$(WasI) <> "" THEN _
  855.             PRINT #2,LineAra$(WasI)
  856.       NEXT
  857.       CLOSE 2
  858. 10994 CLOSE 3
  859.       ZExitToDoors = ZTrue
  860.       IF NOT ZFossil THEN _
  861.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  862.       IF NOT ZPrivateDoor THEN _
  863.          CALL MLInit (2)
  864. 10996 CALL UpdateU (ZTrue)
  865.       CALL GetTime
  866.       CALL SaveProf (1)
  867.       IF NumLines = 0 THEN _
  868.          EXIT SUB
  869.       CALL DelayTime (9 + ZBPS)
  870.       IF ZFossil THEN _
  871.          CALL FOSExit(ZComPort)
  872.       SYSTEM
  873.       END SUB
  874. 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts'
  875. ' $PAGE
  876. '  NAME    -- SetSection         Doug Azzarito
  877. '
  878. '  INPUTS  -- PARAMETER             MEANING
  879. '             ZMenuIndex      2 = user is in MAIN section
  880. '                             3 = user is in FILE section
  881. '                             4 = user is in UTIL section
  882. '                             6 = user is in LIBR section
  883. '
  884. '  OUTPUTS -- ZSection$       4 character section name
  885. '             ZActiveMenu$    1 character section name
  886. '             ZSectionPrompt$ Section name (if ZShowSection config)
  887. '             ZCmdPrompt$     Command input prompt string
  888. '             ZSectionOpts$   List of options valid in this sect
  889. '             ZInvalidOpts$   List of options invalid in this sect
  890. '             ZSubSection     Index into security array for section
  891. '
  892. '  PURPOSE -- To build the prompt strings for the current section
  893. '
  894.       SUB SetSection                                                 ' RM03309401
  895.       IF ZMenuIndex <> 6 THEN _
  896.          ZCurDirPath$ = ZDirPath$
  897.       ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015
  898. 12001 EXIT SUB
  899. 12005 LSET ZSection$ = "FILE"
  900.       ZSectionOpts$ = ZFileOpts$
  901.       ZInvalidOpts$ = ZInvalidFileOpts$
  902.       ZSubSection = ZBegFile
  903.       GOTO 12025
  904. 12010 LSET ZSection$ = "MAIN"
  905.       ZSectionOpts$ = ZMainOpts$
  906.       ZInvalidOpts$ = ZInvalidMainOpts$
  907.       ZSubSection = ZBegMain
  908.       GOTO 12025
  909. 12015 LSET ZSection$ = "LIBR"
  910.       ZSectionOpts$ = ZLibOpts$
  911.       ZInvalidOpts$ = ZInvalidLibraryOpts$
  912.       ZSubSection = ZBegLibrary
  913.       ZCurDirPath$ = ZLibDirPath$
  914.       GOTO 12025
  915. 12020 LSET ZSection$ = "UTIL"
  916.       ZSectionOpts$ = ZUtilOpts$
  917.       ZInvalidOpts$ = ZInvalidUtilOpts$
  918.       ZSubSection = ZBegUtil
  919. 12025 ZActiveMenu$ = LEFT$(ZSection$,1)
  920.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  921.       IF ZShowSection THEN _
  922.          ZSectionPrompt$ = ZSection$ _
  923.       ELSE ZSectionPrompt$ = "Your"
  924.       IF ZCmndsInPrompt=0 THEN _
  925.           ZSectionOpts$ = ""
  926.       ZCmdPrompt$ = ZSectionPrompt$ + _
  927.                         " command" + _
  928.                         ZSectionOpts$
  929.       END SUB
  930. 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay'
  931. ' $PAGE
  932. '
  933. '  NAME    -- UntilRight
  934. '
  935. '  INPUTS  -- PARAMETER             MEANING
  936. '             Ques$         QUESTION TO BE ASKED THE USER
  937. '             Ans$          LOCATION TO STORE THE ANSWER
  938. '             MinLen        MINIMUM LENGTH OF ANSWER
  939. '             MaxLen        MAX LENGTH OF ANSWER
  940. '
  941. '  OUTPUTS -- Ans$          RESPONSE TO THE QUESTION WHICH THE
  942. '                                      CALLERS SAYS IS CORRECT
  943. '
  944. '  PURPOSE -- Subroutine to ask a user a question until the caller
  945. '             responds that the answer is correct
  946. '
  947.       SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC
  948. 12880 ZParseOff = ZTrue
  949.       ZOutTxt$ = Ques$
  950.       CALL PopCmdStack
  951.       IF ZSubParm = -1 THEN _
  952.          GOTO 12882
  953.       IF ZWasQ = 0 THEN _
  954.          GOTO 12880
  955.       IF LEN(ZUserIn$(ZAnsIndex)) > MaxLen THEN _
  956.          ZLastIndex = 0 : _
  957.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  958.          GOTO 12880 _                                                ' RM041101
  959.       ELSE IF LEN(ZUserIn$(ZAnsIndex)) < MinLen THEN _
  960.               ZLastIndex = 0 : _
  961.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  962.               GOTO 12880
  963.       Ans$ = ZUserIn$(ZAnsIndex)
  964.       IF ZAnsIndex < ZLastIndex THEN _
  965.          GOTO 12881
  966.       ZOutTxt$ = ZUserIn$(ZAnsIndex) + _
  967.            ", right ([Y],N)"
  968.       ZTurboKey = -ZTurboKeyUser
  969.       ZSubParm = 1
  970.       CALL TGet
  971.       IF ZSubParm = -1 THEN _
  972.          GOTO 12882
  973.       IF ZNo THEN _
  974.          GOTO 12880
  975. 12881 CALL AllCaps (Ans$)
  976.       EXIT SUB
  977. 12882 Ans$ = "GUEST"
  978.       END SUB
  979. 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file'
  980. ' $PAGE
  981. '
  982. '  NAME    -- LogError
  983. '
  984. '  INPUTS  --     PARAMETER                    MEANING
  985. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  986. '                    ERL           Last LINE NUMBER ENCOUNTERED
  987. '                                  PRIOR TO ENCOUNTERNING ERROR
  988. '
  989. '  OUTPUTS -- NONE
  990. '
  991. '  PURPOSE -- To set up a string to write to the callers log
  992. '             indicating the date, time, error, and error line
  993. '
  994.       SUB LogError                                                   ' RM11159302
  995.       WasIX = ERR
  996.       IF ERR < 1 THEN _
  997.          WasIX = ZErrCode
  998.       CALL UpdtCalr("+++ Error " + _
  999.            STR$(WasIX) + _
  1000.            " line " + _
  1001.            STR$(ERL) + _
  1002.            " at " + _
  1003.            TIME$ + _
  1004.            " on " + _
  1005.            DATE$,2)
  1006.       END SUB
  1007. '
  1008. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  1009. ' $PAGE
  1010. '
  1011. '  NAME    -- CheckRatio
  1012. '
  1013. '  INPUTS  --   PARAMETER                    MEANING
  1014. '               TellUser           TELL USER THEIR RATIO
  1015. '               ZDnlds             FILES DOWNLOADED
  1016. '               ZDLBytes!          BYTES DOWNLOADED
  1017. '               ZUplds             FILES UPLOADED
  1018. '               ZULBytes!          BYTES UPLOADED
  1019. '
  1020. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  1021. '
  1022. '  PURPOSE -- To determine whether the users violated
  1023. '             their upload to download restriction
  1024. '
  1025.       SUB CheckRatio (TellUser) STATIC
  1026.       ZOK = ZTrue
  1027.       IF ZRatioRestrict# <= 0 OR (NOT ZEnforceRatios) OR ZFreeDnld THEN _
  1028.          GOTO 20110
  1029. '
  1030. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  1031. '
  1032.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  1033.          Method$ = "Bytes" : _
  1034.          ULWork# = ZULBytes! : _
  1035.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  1036.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  1037.          Method$ = "Files" : _
  1038.          ULWork# = ZUplds : _
  1039.          DLWork# = ZDnlds + ZDownFiles
  1040.       IF ULWork# < ZInitialCredit# THEN _
  1041.          ULWork# = ZInitialCredit#
  1042.       IF ZByteMethod = 2 THEN _
  1043.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  1044.       IF ZByteMethod = 3 THEN _
  1045.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  1046. '
  1047.       Ratio# = 0
  1048.       RatioSuffix$ = ":0"
  1049.       IF ULWork# > 0 THEN _
  1050.          Ratio# = (DLWork# / ULWork#) : _
  1051.          RatioSuffix$ = ":1"
  1052.       IF ZByteMethod > 1 THEN                                        ' DGS070301-DS
  1053.          IF ZBytesToday! > 0 THEN _                                  ' DGS070301-DS
  1054.             DGSTemp! = ZBytesToday!                                  ' DGS070301-DS
  1055.          DGSTemp! = DGSTemp! + ZNumDnldBytes!                        ' DGS070301-DS
  1056.          ZOutTxt$ = ZFGB$ + "Today's Downloaded Files: " + _         ' DD090202
  1057.               ZFGF$ + STR$(ZDLToday! + ZDownFiles) + ZCrLf$ + _      ' DD090202
  1058.               ZFGB$ + "Number of Bytes Today: " + _                  ' DD090701
  1059.               ZFGF$ + STR$(DGSTemp!) + _                             ' DGS070301-DS
  1060.               ZEmphasizeOff$                                         ' DD090701
  1061.          DGSTemp! = 0                                                ' DGS070301-DS
  1062.          ZSubParm = 5                                                ' DGS070301-DS
  1063.          CALL TPut                                                   ' DGS070301-DS
  1064.          CALL SkipLine (1)                                           ' DGS070301-DS
  1065.          GOTO 20100                                                  ' DGS070301-DS
  1066.       END IF                                                         ' DGS070301-DS
  1067.       WasX$ = STR$(Ratio#)
  1068.       X = INSTR(WasX$,".")
  1069.       IF X > 0 THEN _
  1070.          WasX$ = LEFT$(WasX$,X+1)
  1071.       ZOutTxt$ = Method$ + " Downloaded:" + STR$(DLWork#) + _
  1072.               " Uploaded:" + _
  1073.               STR$(ULWork#) + _
  1074.               " Ratio:" + _
  1075.               WasX$ + _
  1076.               RatioSuffix$
  1077.       ZSubParm = 5
  1078.       CALL TPut
  1079. '
  1080. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  1081. '
  1082. 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  1083.          EXIT SUB
  1084.       IF ZByteMethod <= 1 THEN _
  1085.          GOTO 20105
  1086.       IF Today# < 0 THEN                                             ' DGS062401-DS
  1087.          ZOutTxt$ = ZFGF$ + ZBG4$ + _                                ' DD082301
  1088.               "Sorry, Today's Daily Download limit of"               ' DD082301
  1089.          IF ZBytesToday! < 0 THEN                                    ' DGS062401-DS
  1090.             ZOutTxt$ = ZOutTxt$ + STR$(ZRatioRestrict# - ZBytesToday!) ' DGS062401-DS
  1091.          ELSE                                                        ' DGS062401-DS
  1092.             ZOutTxt$ = ZOutTxt$ + STR$(ZRatioRestrict#)              ' DGS062401-DS
  1093.          END IF                                                      ' DGS062401-DS
  1094.          ZOutTxt$ = ZOutTxt$ + SPACE$(1) + Method$ + " Reached" + _  ' DGS062401-DS
  1095.                     ZBG0$ + ZEmphasizeOff$                           ' DD082301
  1096.          ZOK = ZFalse                                                ' DGS062401-DS
  1097.          ZNumDnldBytes! = 0                                          ' DGS070301-DS
  1098.       ELSE                                                           ' DGS062401-DS
  1099.          ZOutTxt$ = ZFGA$ + "Download balance:" + _                  ' DD082301
  1100.                 ZFGE$ + STR$(Today#) + SPACE$(1) + _                 ' DGS062401-DS                       ' DD021301
  1101.                 ZFGF$ + Method$ + ZEmphasizeOff$                     ' DD082301
  1102.          ZOK = ZTrue                                                 ' RM10069308
  1103.       END IF                                                         ' DGS062401-DS
  1104.       ZSubParm = 5
  1105.       CALL TPut
  1106.       CALL SkipLine(1)
  1107.       EXIT SUB
  1108. '
  1109. 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
  1110.          ZOK = ZFalse : _
  1111.          ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  1112.               STR$(ZRatioRestrict#) + _
  1113.               ":1 " + _
  1114.               Method$ + " exceeded" : _
  1115.          ZSubParm = 5 : _
  1116.          CALL TPut : _
  1117.          ZOutTxt$ = "Minimum upload of" + _
  1118.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  1119.               / ZRatioRestrict#) + 1)) + _
  1120.               + " " + Method$ + " required to download" _
  1121.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  1122.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  1123.                 " " + Method$
  1124.       ZSubParm = 5
  1125.       CALL TPut
  1126.       CALL SkipLine (1)
  1127. 20110 END SUB
  1128. 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list'
  1129. ' $PAGE
  1130. '
  1131. '  NAME    -- GetArc
  1132. '
  1133. '  INPUTS  --     PARAMETER                    MEANING
  1134. '                 ZWasQ                       NUMBER OF ENTRIES TYPED
  1135. '                 ZUserIn$()                  ENTRIES TYPED
  1136. '
  1137. '  OUTPUTS --
  1138. '
  1139. '  PURPOSE --  Process the V)erbose list command.
  1140. '              Takes what user types and tries to list it.
  1141. '
  1142.       SUB GetArc STATIC
  1143. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  1144.          IF LEN(ZDefaultExtension$) > 0 THEN _
  1145.             CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$)
  1146.       WasZ$ = "V"
  1147.       CALL Line25                                                    ' RM01239401
  1148.       CALL AskItems ("V",WasZ$,ZFalse,"file",ZMarkedFiles$,ZPersonalDnld) ' RM01209401
  1149.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1150.          EXIT SUB
  1151.       ZViolation$ = "View ARC"
  1152.       WasX = ZAnsIndex
  1153.       ZAnsIndex = WasX
  1154. 20142 IF ZAnsIndex > ZLastIndex THEN _
  1155.          IF ZLastIndex > 1 OR Drive$ <> "" THEN _                    ' KG091001
  1156.             EXIT SUB _
  1157.          ELSE GOTO 20141
  1158.       GOSUB 20143
  1159.       IF ZSubParm < 0 THEN _
  1160.          EXIT SUB
  1161.       ZAnsIndex = ZAnsIndex + 1
  1162.       GOTO 20142
  1163. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1164.       CALL UnMarkItems (ZMarkedFiles$,ZAnsIndex,ZLastIndex,Temp,ZFalse)
  1165.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  1166.       WasZ$ = ZWasZ$
  1167.       CALL AllCaps (ZWasZ$)
  1168.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  1169.       IF Ext$ = "" THEN _
  1170.          Ext$ = ZDefaultExtension$ : _
  1171.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  1172.       ZFileNameHold$ = ZWasZ$
  1173.       ZFileName$ = ZWasZ$
  1174.       CALL BadFile (Prefix$,BadFileNameIndex)
  1175.       ON BadFileNameIndex GOTO 20144,20146,20147
  1176. 20144 CALL BadFile (ZFileName$,BadFileNameIndex)
  1177.       ON BadFileNameIndex GOTO 20145,20146,20147
  1178. 20145 IF Drive$ <> "" THEN _                                         ' KG091001
  1179.          ZFileNameHold$ = Prefix$ + "." + Ext$ : _                   ' KG091001
  1180.          CALL FindFile (ZFileName$,ZOK) _                            ' KG091001
  1181.       ELSE CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") ' KG091001
  1182.       IF NOT ZOK AND ZPersonalDnld THEN _                            ' RM01209401
  1183.          ZFileName$ = ZPersonalDrvPath$ + ZWasZ$ : _                 ' RM01209401
  1184.          CALL FindFile (ZFileName$,ZOK)                              ' RM01209401
  1185.       IF ZOK THEN _
  1186.          GOTO 20148
  1187. 20146 CALL AllCaps(WasZ$)                                            ' DGS041601-TH/RM10059301
  1188.       ZWasZ$ = WasZ$ + _
  1189.            " not found!"
  1190.       CALL UpdtCalr (ZWasZ$,2)
  1191.       ZOutTxt$ = ZFGB$ + ZWasZ$ + _
  1192.            " Type correct filename " + ZFirstName$ + _
  1193.            ZPressEnterExpert$  + ZEmphasizeOff$                      ' DGS041601-TH/RM01069402
  1194.       ZSubParm = 1
  1195.       CALL TGet
  1196.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1197.          RETURN
  1198.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  1199.       GOTO 20143
  1200. 20147 CALL SecViolation
  1201.       IF ZDenyAccess THEN _
  1202.          EXIT SUB
  1203.       GOTO 20146
  1204. 20148 WasX$ = ZDiskForDos$ + "VIEW.BAT"                              ' RM09119301
  1205.       CALL Graphic (WasX$)                                           ' RM0911]301
  1206.       IF NOT ZOK THEN _
  1207.          GOTO 20150
  1208.       ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  1209.       CALL ReadDir (2,1)
  1210.       IF EOF(2) THEN _
  1211.          ZWasZ$ = ZOutTxt$ : _
  1212.          ZGSRAra$(1) = ZFileName$ : _
  1213.          ZGSRAra$(2) = ZArcWork$ _
  1214.       ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + " " + ZArcWork$ + _   ' RM09119301
  1215.                     " " + Ext$ + " " + ZNodeID$ + " " + ZGSRAra$(3)  ' RM09119301
  1216.       CALL ShellExit (ZWasZ$)
  1217.       CALL BufFile (ZArcWork$,WasX)
  1218.       RETURN
  1219. 20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".")
  1220.       'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _
  1221.       IF (WasX < 1) THEN _
  1222.          CALL QuickTPut1 ("View not implemented") : _                ' RM09119301
  1223.          RETURN
  1224.       CALL QuickTPut1 (ZFileNameHold$ + " has these files")
  1225.       CALL ViewArc
  1226.       RETURN
  1227.       END SUB
  1228. 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names'
  1229. ' $PAGE
  1230. '
  1231. '  NAME    -- BadName
  1232. '
  1233. '  INPUTS  --     PARAMETER                    MEANING
  1234. '               ZActiveMessageFile$
  1235. '               ZActiveUserFile$
  1236. '               ZCallersFile$
  1237. '               ZCmntsFile$
  1238. '               CONFIG.FILEANAME$
  1239. '               ZMainMsgBackup$
  1240. '               ZMainMsgFile$
  1241. '               ZMaxViolations
  1242. '               ZPswdFile$
  1243. '               ZRBBSBat$
  1244. '               ZRCTTYBat$
  1245. '               ZSubDir$()
  1246. '               ZSubDirIndex
  1247. '               ZViolation$
  1248. '               ZViolationsThisSession
  1249. '               ZWasZ$                          NAME OF FILE
  1250. '               ProtectExt              -1 if check for extension
  1251. '                                        0 to allow any extension
  1252. '
  1253. '  OUTPUTS  -- BadFileNameIndex         1 = FILE NAME IS OK
  1254. '                                       2 = SECURITY BREACH TRIED
  1255. '
  1256. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  1257. '             to either crash the system or to breach RBBS-PC's security
  1258. '
  1259.       SUB BadName (BadFileNameIndex,ProtectExt)                      ' RM03309401
  1260. '
  1261. '
  1262. ' *  TEST FOR SYSTEM FILE ATTEMPT
  1263. '
  1264.       BadFileNameIndex = 2
  1265.       ZWasZ$ = ZFileName$
  1266.       CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse)
  1267.       IF LEN(Extension$) = 3 AND ProtectExt THEN _
  1268.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _
  1269.             EXIT SUB
  1270.       ZOK = 0
  1271.       IF ProtectExt THEN _
  1272.          CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$)
  1273.       CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$)
  1274.       CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$)
  1275.       CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$)
  1276.       CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$)
  1277.       CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$)
  1278.       CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$)
  1279.       CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$)
  1280.       CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$)
  1281.       CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$)
  1282.       CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$)
  1283.       CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$)
  1284.       IF ZOK = 0 THEN _
  1285.          BadFileNameIndex = 1
  1286.       END SUB
  1287. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  1288. ' $PAGE
  1289. '
  1290. '  NAME    -- FileNameCheck
  1291. '
  1292. '  INPUTS  --     PARAMETER                    MEANING
  1293. '               CheckThis$           Name of file to check
  1294. '               Pref2$               Prefix to match against
  1295. '               Ext2$                Extension to match against
  1296. '
  1297. '  OUTPUTS  -- ZOK                    1 if got match
  1298. '
  1299. '  PURPOSE -- Checks for match on both prefix and extension of a file
  1300. '             name.   Used to catch match on system files not to be
  1301. '             downloaded.
  1302. '
  1303.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  1304.       IF ZOK > 0 THEN _
  1305.          EXIT SUB
  1306.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  1307.       IF Pref1$ = Pref2$ THEN _
  1308.          IF Ext1$ = Ext2$ THEN _
  1309.             ZOK = 1
  1310.       END SUB
  1311. 20245 SUB SetBPS (BaudTest!,BPS)                                     ' RM03309401
  1312.       IF BaudTest! > 0 AND BaudTest! < 50 THEN _                     ' BB08219301
  1313.          BaudTest! = BaudTest! * 1000  ' Support 14.4 for 14,400     ' RM10289301
  1314.       IF BaudTest! = 2400 THEN _
  1315.          BPS = -4 _
  1316.       ELSE IF BaudTest! = 1200 OR BaudTest! = 1275 THEN _
  1317.          BPS = -3 _
  1318.       ELSE IF BaudTest! >= 7200 AND BaudTest! < 19200 THEN _
  1319.          GOTO 20246 _
  1320.       ELSE IF BaudTest! = 0 OR BaudTest! = 300 THEN _
  1321.          BaudTest! = 300 : _
  1322.          BPS = -1 _
  1323.       ELSE IF BaudTest! = 450 THEN _                                 ' BB062501
  1324.          BPS = -2 _                                                  ' BB062501
  1325.       ELSE IF BaudTest! = 19200 THEN _
  1326.          BPS = -11 _
  1327.       ELSE IF BaudTest! = 21600 THEN _                               ' BB09069301
  1328.          BPS = -12 _                                                 ' BB09069301
  1329.       ELSE IF BaudTest! = 24000 THEN _                               ' RM11279301
  1330.          BPS = -13 _                                                 ' RM11279301
  1331.       ELSE IF BaudTest! = 26400 THEN _                               ' RM11279301
  1332.          BPS = -14 _                                                 ' RM11279301
  1333.       ELSE IF BaudTest! = 28800 THEN _                               ' BB062501
  1334.          BPS = -15 _                                                 ' BB062501/RM11279301
  1335.       ELSE IF BaudTest! = 38400 THEN _
  1336.          BPS = -16 _                                                 ' BB062501/BB09039301/RM11279301
  1337.       ELSE IF BaudTest! = 57600 THEN _                               ' BB062501
  1338.          BPS = -17 _                                                 ' BB062501/RM11279301
  1339.       ELSE IF BaudTest! = 4800 THEN _
  1340.          BPS = -5 _
  1341.       ELSE BPS = 0
  1342.       EXIT SUB
  1343. 20246 IF BaudTest! = 14400 THEN _
  1344.          BPS = -9 _
  1345.       ELSE IF BaudTest! = 16800 THEN _
  1346.          BPS = -10 _
  1347.       ELSE IF BaudTest! = 7200 THEN _
  1348.          BPS = -6 _
  1349.       ELSE IF BaudTest! = 12000 THEN _
  1350.          BPS = -8 _
  1351.       ELSE BPS = -7       ' 9600
  1352.       END SUB
  1353. 20340 ' $SUBTITLE: 'QuickPeek - Easy find user to send message to'   ' HB030692
  1354. ' $PAGE                                                              ' HB030692
  1355. '                                                                    ' HB030692
  1356. '  NAME    -- QuickPeek                                              ' HB030692
  1357. '                                                                    ' HB030692
  1358. '                 PARAMETER                    MEANING               ' PEEK174
  1359. '                                                                    ' PEEK174
  1360. '  INPUTS  --     ZUserIn$                Search String User Input   ' HB030692
  1361. '                                                                    ' HB030692
  1362. '  OUTPUTS --     MsgTo$                  Who Message is To          ' HB030692
  1363. '                                                                    ' HB030692
  1364. '  PURPOSE -- Save User keystrokes when looking for message addressee' HB030692
  1365. '                                                                    ' HB030692
  1366.       SUB QuickPeek (MsgTo$,WhoFound)  STATIC                        ' PEEK174/RM02129401
  1367.       IF WhoFound = ZTrue THEN EXIT SUB                              ' PEEK174
  1368.       SaveTxt$ = ZOutTxt$                                            ' RM101801
  1369.       WhichUser = 1                                                  ' PEEK174
  1370.       CALL OpenUser (ZHighestUserRecord)                             ' PEEK174
  1371.       WHILE NOT EOF(5)                                               ' HB030692
  1372.          GET #5, WhichUser                                           ' PEEK174
  1373.          TempMsgTo$ = ZUserName$                                     ' PEEK174
  1374.          CALL TRIM (TempMsgTo$)                                      ' PEEK174
  1375.          IF MsgTo$ = TempMsgTo$ THEN EXIT SUB                        ' PEEK174
  1376.          InTo = INSTR(TempMsgTo$,MsgTo$)
  1377.          IF InTo > 0 THEN                                            ' PEEK174
  1378.             IF TempMsgTo$ = ZSecretName$ THEN _                      ' PEEK174
  1379.                GOTO 20345                                            ' PEEK174
  1380.             Temp = LEN(MsgTo$)
  1381.             TempMsgToWork$ = TempMsgTo$
  1382.             TempMsgToWork$ = MID$(TempMsgTo$,1,Into - 1) + ZEmphasizeOn$ + MsgTo$ + _
  1383.                               ZEmphasizeOff$ + ZFG7$ + MID$(TempMsgTo$,InTo + Temp)
  1384.             ZOutTxt$ = ZFG6$ + SaveTxt$ + ZFG7$ + TempMsgToWork$ + _
  1385.                        ZFG6$ + " ( " + ZFG7$ + "Y" + ZFG6$ + ")es, [N]" + _
  1386.                        ZFG6$ + ")o, " + ZFG7$ + "A" + ZFG6$ + ")bort )" + ZEmphasizeOff$ ' RM101801
  1387.             ZSubParm = 1                                             ' PEEK174
  1388.             CALL TGet                                                ' PEEK174
  1389.             IF ZSubParm = -1 THEN _                                  ' PEEK174
  1390.                EXIT SUB                                              ' PEEK174
  1391.             IF ZWasQ = 0 THEN _                                      ' RM02129401
  1392.                GOTO 20345                                            ' RM02129401
  1393.             CALL AllCaps (ZUserIn$)                                  ' PEEK174/RM02129401
  1394.             IF ZUserIn$ = "A" THEN _                                 ' PEEK174/RM02129401
  1395.                EXIT SUB                                              ' PEEK174
  1396.             IF ZUserIn$ = "Y" THEN                                   ' PEEK174/RM02129401
  1397.                MsgTo$ = TempMsgTo$                                   ' PEEK174
  1398.                WhoFound = ZTrue                                      ' PEEK174
  1399.                EXIT SUB                                              ' PEEK174
  1400.             END IF                                                   ' PEEK174
  1401.          END IF
  1402. 20345    WhichUser = WhichUser + 1                                   ' PEEK174
  1403.       WEND                                                           ' PEEK174
  1404.       END SUB                                                        ' PEEK174
  1405. 20350 ' SUBTITLE: 'PersonalRing - Detects "Distinctive Ring" patterns from Phone Co. ' JR070101
  1406. ' PAGE$                                                              ' RM070501
  1407. '                                                                    ' RM070501
  1408. ' NAME: PersonalRing                                                 ' RM070501
  1409. '                                                                    ' RM070501
  1410. '                 PARAMETER                    MEANING               ' RM070501
  1411. '                                                                    ' RM070501
  1412. ' INPUTS         PAnswer                                             ' RM070501
  1413. '                                                                    ' RM070501
  1414. '                Sreg                    Setting of S0 Register      ' RM070501
  1415. '                                                                    ' RM070501
  1416. ' PURPOSE:  To distinguish the ring pattern on those phones using    ' RM070501
  1417. '           multiple numbers on single line utilizing the Phone      ' RM070501
  1418. '           Company's distinctive ring patterns.                     ' RM070501
  1419. '                                                                    ' RM070501
  1420.       DEFINT A-Z                                                     ' JR070125
  1421.       SUB PersonalRing (PAnswer, Sreg) STATIC                        ' JR070126
  1422. 20352 LOCATE 21,23                                                   ' JR070127/MENU174
  1423.       IF ZDosANSI THEN _                                             ' RM112102
  1424.          CALL LPrnt(ZEscape$ + "[1;40;31m" + " PERSONAL RING" + _
  1425.                     ZEscape$ + "[00m",0) _                           ' RM112102
  1426.       ELSE _                                                         ' RM112102
  1427.          CALL LPrnt(" PERSONAL RING",0)                              ' JR070128/RM070601/RM112102
  1428.       ptimeout! = TIMER                                              ' JR070129
  1429.       DO                                                             ' JR070130
  1430.          DetectedRing = INP(ZModemStatusReg) AND &H40                ' JR070131
  1431.          ptimeend! = TIMER                                           ' JR070132
  1432.          IF ptimeend! - ptimeout! > 5 THEN                           ' JR070133
  1433.             LOCATE 21,23                                             ' JR070134/MENU174
  1434.             CALL LPrnt("              ",0)                           ' JR070135/RM070601
  1435.             EXIT SUB                                                 ' JR070136
  1436.          END IF                                                      ' JR070137
  1437.       LOOP UNTIL DetectedRing = 0                                    ' JR070138
  1438.          ptimeout! = TIMER                                           ' JR070139
  1439.          DO                                                          ' JR070140
  1440.             DetectedRing = INP(ZModemStatusReg) AND &H40             ' JR070141
  1441.             ptimeend! = TIMER                                        ' JR070142
  1442.             IF ptimeend! - ptimeout! > 5 THEN                        ' JR070143
  1443.                LOCATE 21,23                                          ' JR070144/MENU174
  1444.                CALL LPrnt("              ",0)                        ' JR070145/RM070601
  1445.                EXIT SUB                                              ' JR070146
  1446.             END IF                                                   ' JR070147
  1447.          LOOP UNTIL DetectedRing > 0                                 ' JR070148
  1448.          RingStarted! = TIMER                                        ' JR070149
  1449.          ptimeout! = TIMER                                           ' JR070150
  1450.          DO                                                          ' JR070151
  1451.             DetectedRing = INP(ZModemStatusReg) AND &H40             ' JR070152
  1452.             ptimeend! = TIMER                                        ' JR070153
  1453.             IF ptimeend! - ptimeout! > 5 THEN                        ' JR070154
  1454.                LOCATE 21,23                                          ' JR070155/MENU174
  1455.                CALL LPrnt("              ",0)                        ' JR070156/RM070601
  1456.                EXIT SUB                                              ' JR070157
  1457.             END IF                                                   ' JR070158
  1458.          LOOP UNTIL DetectedRing = 0                                 ' JR070159
  1459.          RingStopped! = TIMER                                        ' JR070160
  1460.          RingLength! = RingStopped! - RingStarted!                   ' JR070161
  1461.             IF Sreg = 253 THEN                                       ' JR070162
  1462.          ' Telephone Ring = Regular Ring...                          ' JR070163
  1463.                IF RingLength! > 1.5 THEN                             ' JR070164
  1464.                   PAnswer = 1                                        ' JR070165
  1465.                END IF                                                ' JR070166
  1466.          ' Telephone Ring = Short Ring...                            ' JR070167
  1467.             ELSEIF Sreg = 252 THEN                                   ' JR070168
  1468.                IF RingLength! < 1.3 THEN                             ' JR070169
  1469.                   PAnswer = 1                                        ' JR070170
  1470.                END IF                                                ' JR070171
  1471.             END IF                                                   ' JR070172
  1472.             LOCATE 21,23                                             ' JR070173/MENU174
  1473.             CALL LPrnt("              ",0)                           ' JR070174/RM070601
  1474.       END SUB                                                        ' JR070175
  1475. 63200 ' $SUBTITLE: 'WildCard -- Matches string to a pattern'
  1476. ' $PAGE
  1477. '  NAME    -- WildCard
  1478. '
  1479. '  INPUTS  -- PARAMETER             MEANING
  1480. '             Pattern$           PATTERN TO CHECK
  1481. '             Strng$             STRING TO FIE
  1482. '
  1483. '  OUTPUTS -- ZOK                True IF MATCH Found
  1484. '                                False IF No MATCH WAS Found
  1485. '
  1486. '  PURPOSE  Determine whether a string is an instance in a pattern
  1487. '           supported patterns are only "?" which requires a
  1488. '           character but can be any, and "*" which matches any-
  1489. '           thing, including a null string.  Anything else in a
  1490. '           sting must be an exact match.  Supports reverse
  1491. '           wildcards.
  1492. '
  1493. '
  1494.       SUB WildCard (Pattern$,Strng$) STATIC
  1495. 63285 ZOK = ZTrue
  1496.       PatPos = 0
  1497.       StrPos = 0
  1498.       Inc = 1
  1499.       WasKT = 0
  1500.       WasP = LEN(Pattern$)
  1501.       WasL = LEN(Strng$)
  1502. 63286 PatPos = PatPos + Inc
  1503.       StrPos = StrPos + Inc
  1504.       WasKT = WasKT + 1
  1505.       IF WasKT > WasL THEN _
  1506.          GOTO 63288
  1507.       ZUserIn$ = MID$(Pattern$,PatPos,1)
  1508.       IF ZUserIn$ = "*" THEN _
  1509.          GOTO 63289
  1510. 63287 IF ZUserIn$ <> "?" AND MID$(Strng$,StrPos,1) <> ZUserIn$ THEN _
  1511.          ZOK = ZFalse : _
  1512.          EXIT SUB
  1513.       GOTO 63286
  1514. 63288 IF PatPos >= LEN(Pattern$) OR PatPos < 1 THEN _
  1515.          EXIT SUB
  1516.       IF MID$(Pattern$,PatPos,1) <> "*" THEN _
  1517.          ZOK = ZFalse : _
  1518.          EXIT SUB
  1519. 63289 IF PatPos <> WasP THEN _   ' Reverse search
  1520.          Inc = -1 : _
  1521.          WasP = PatPos : _
  1522.          PatPos = LEN(Pattern$) + 1 : _
  1523.          StrPos = LEN(Strng$) + 1 : _
  1524.          WasKT = 0 : _
  1525.          GOTO 63286
  1526.       END SUB
  1527. 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS'
  1528. ' $PAGE
  1529. '
  1530. '  NAME    -- ShellExit
  1531. '
  1532. '  INPUTS  -- ShellTem$     String to invoke shell with
  1533. '
  1534. '  OUTPUTS -- none
  1535. '
  1536. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  1537. '             port on return
  1538. '
  1539.       SUB ShellExit (ShellTem$)                                      ' RM11159302
  1540.       CALL DelayTime (8 + ZBPS)
  1541.       IF NOT ZLocalUser THEN _
  1542.          IF ZFossil THEN _
  1543.             CALL FOSExit(ZComPort) _
  1544.          ELSE CLOSE 3 : _
  1545.               OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  1546.       CLOSE 2
  1547.       CALL MetaGSR (ShellTem$,ZFalse)
  1548.       SHELL ShellTem$
  1549.       IF ZFossil THEN _
  1550.          IF NOT ZLocalUser THEN _
  1551.             CALL FOSinit(ZComPort,Result) : _
  1552.             IF Result = -1 THEN _
  1553.                CALL PScrn("ERROR INIT FOSSIL AFT EXTERNAL") : _
  1554.                SYSTEM
  1555.       CALL DelayTime (2)
  1556.       CALL RestoreCom
  1557.       END SUB
  1558. 63400 ' $SUBTITLE: 'LockAppend - prepares for file append'
  1559. ' $PAGE
  1560. '
  1561. '  NAME    -- LockAppend
  1562. '
  1563. '  INPUTS  -- ZWasEN$            Name of file to append to
  1564. '
  1565. '  OUTPUTS -- none
  1566. '
  1567. '  PURPOSE -- Locks and opens file to append to
  1568. '
  1569.       SUB LockAppend                                                 ' RM03309401
  1570.       WasBX = &H4
  1571.       ZSubParm = 9
  1572.       CALL FileLock
  1573.       ZErrCode = 0
  1574.       CALL OpenWorkA (ZWasEN$)
  1575.       END SUB
  1576. 63410 ' $SUBTITLE: 'UnLockAppend - cleans up after file append'
  1577. ' $PAGE
  1578. '
  1579. '  NAME    -- UnLockAppend
  1580. '
  1581. '  INPUTS  -- none
  1582. '
  1583. '  OUTPUTS -- none
  1584. '
  1585. '  PURPOSE -- Unlocks and close file appending to
  1586. '
  1587.       SUB UnLockAppend                                               ' RM03309401
  1588.       WasBX = &H4
  1589.       ZSubParm = 10
  1590.       CALL FileLock
  1591.       CLOSE 2
  1592.       END SUB
  1593. 63420 ' $SUBTITLE: 'FormRead - Reads from a file into a form'
  1594. ' $PAGE
  1595. '
  1596. '  NAME    -- FormRead
  1597. '
  1598. '  INPUTS  -- Template$      Display formvoke shell with
  1599. '             FilName$       Data file to get values from
  1600. '             FixedLength    Whether file is fixed length
  1601. '             DataVar       # bytes data if fixed length; # fields
  1602. '                              if variable length
  1603. '             OverStrike     Whether typeover into form or insert
  1604. '             RecPause      Whether pause after every record displayed
  1605. '                               otherwise when screen fills
  1606. '  OUTPUTS -- (displays data base records)
  1607. '
  1608. '  PURPOSE -- Allows field oriented data base data to be displayed
  1609. '               in a human readable format by substituting field
  1610. '               data into template or form
  1611. '
  1612.       SUB FormRead (Template$,FilName$,FixedLength,DataVar,OverStrike,RecPause) STATIC
  1613. 63422 IF EOF(2) OR ZNo OR (ZErrCode > 0) OR (ZSubParm < 0) THEN _
  1614.          Template$ = "" : _
  1615.          EXIT SUB
  1616.       IF FixedLength THEN _
  1617.          CALL ReadDir (2,1) : _
  1618.          ZGSRAra$(1) = ZOutTxt$ _
  1619.       ELSE CALL ReadParms (ZGSRAra$(),DataVar,1)
  1620.       WasX$ = Template$
  1621.       CALL SmartText (WasX$,ZTrue,OverStrike)
  1622.       CALL MetaGSR (WasX$,OverStrike)
  1623.       CALL BufAsUnit (WasX$)
  1624.       IF RecPause OR (ZPageLength > 0 AND (ZLinesPrinted >= ZPageLength-1)) THEN _
  1625.          CALL PauseExit : _
  1626.          EXIT SUB
  1627.       GOTO 63422
  1628.       END SUB
  1629. 63440 ' $SUBTITLE: 'BufAsUnit - prints string with no pauses'
  1630. ' $PAGE
  1631. '
  1632. '  NAME    -- BufAsUnit
  1633. '
  1634. '  INPUTS  -- Strng$     String to print
  1635. '
  1636. '  OUTPUTS -- none
  1637. '
  1638. '  PURPOSE -- Prints string with embedded carriage returns.
  1639. '             Will never pause.  Used to print when can't call TGet
  1640. '
  1641.       SUB BufAsUnit (Strng$) STATIC
  1642.       WasL = LEN(Strng$)
  1643.       IF WasL < 1 THEN _
  1644.          EXIT SUB
  1645.       StartByte = 1
  1646. 63450 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  1647.       IF CRat > 0 AND CRat < WasL THEN _
  1648.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  1649.       ELSE CRFound = ZFalse
  1650.       EOLlen = -2 * CRFound
  1651.       IF CRFound THEN _
  1652.          EOD = CRat _
  1653.       ELSE EOD = WasL + 1
  1654.       NumBytes = EOD - StartByte
  1655.       ZOutTxt$ = MID$(Strng$,StartByte,NumBytes)
  1656.       ZSubParm = 4
  1657.       CALL TPut
  1658.       CALL SkipLine (-(CRFound))
  1659.       IF ZRet THEN _
  1660.          EXIT SUB
  1661.       StartByte = EOD + EOLlen
  1662.       IF StartByte <= WasL THEN _
  1663.          GOTO 63450
  1664.       END SUB
  1665. 63460 ' Check if macro exists and execute if does
  1666.       SUB MacroExe (Strng$) STATIC
  1667.       CALL Trim (Strng$)
  1668.       CALL Macro (Strng$,Found)
  1669.       IF NOT Found THEN _
  1670.          EXIT SUB
  1671.       CALL FDMACEXE                                                  ' RM061101
  1672.       END SUB
  1673. 63465 ' Forces a keyboard pause inside a macro
  1674.       SUB PauseExit STATIC
  1675.       ZSubParm = 4
  1676.       ZTurboKey = -ZTurboKeyUser
  1677.       ZOutTxt$ = ZMorePrompt$ + LEFT$(">",-1*ZExpertUser) + MID$("? : ",2*ZTurboKey+1,2)
  1678.       ZForceKeyboard = ZTrue
  1679.       ZNoAdvance = ZTrue
  1680.       CALL TPut
  1681.       ZLinesPrinted = 0
  1682.       ZUserIn$ = ""
  1683.       END SUB
  1684. 63470 ' $SUBTITLE: 'SetPrompt - sub to set prompts based on user security'
  1685. ' $PAGE
  1686. '
  1687. '  NAME    -- SetPrompt
  1688. '
  1689. '  INPUTS  -- PARAMETER           MEANING
  1690. '             ZBegMain          POSITION START OF MAIN CMDS
  1691. '             ZBegFile          POSITION START OF FILE CMDS
  1692. '             ZBegUtil          POSITION START OF UTIL CMDS
  1693. '             ZBegLibrary       POSITION START OF Library CMDS
  1694. '
  1695. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  1696. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  1697. '             ZMainOpts$            MAIN OPTS USER CAN DO
  1698. '             ZFileOpts$            FILE OPTS USER CAN DO
  1699. '             ZUtilOpts$            UTIL OPTS USER CAN DO
  1700. '             ZLibOpts$         Library OPTS USER CAN DO
  1701. '
  1702. '  PURPOSE -- Sets command line display of what user can do by
  1703. '             section and display of what all user can do
  1704. '
  1705.       SUB SetPrompt STATIC
  1706.       First = ZBegMain
  1707.       Last = ZBegFile - 1
  1708.       CALL SetOpts (ZMainOpts$,ZInvalidMainOpts$,First,Last)
  1709.       First = ZBegFile
  1710.       Last = ZBegUtil - 1
  1711.       CALL SetOpts (ZFileOpts$,ZInvalidFileOpts$,First,Last)
  1712.       First = ZBegUtil
  1713.       Last = ZBegLibrary - 1
  1714.       CALL SetOpts (ZUtilOpts$,ZInvalidUtilOpts$,First,Last)
  1715.       First = ZBegLibrary
  1716.       Last = ZBegLibrary + 6
  1717.       CALL SetOpts (ZLibOpts$,ZInvalidLibraryOpts$,First,Last)
  1718.       First = 50
  1719.       Last = 56
  1720.       CALL SetOpts (SysOpt$,ZInvalidSysOpts$,First,Last)
  1721.       First = 46
  1722.       Last = 49
  1723.       CALL SetOpts (GlobalOpts$,InvalidGlobalOpts$,First,Last)
  1724.       IF LEN(SysOpt$) > 0 THEN _
  1725.          ZSystemOpts$ = "Sysop: " + _
  1726.                         SysOpt$
  1727.       ZMainOpts$ = GlobalOpts$ + ZMainOpts$ + _
  1728.                    MID$(ZAllOpts$,INSTR(ZOrigCommands$,"G"),1)
  1729.       ZFileOpts$ = GlobalOpts$ + _
  1730.                    ZFileOpts$
  1731.       ZUtilOpts$ = GlobalOpts$ + _
  1732.                    ZUtilOpts$
  1733.       ZLibOpts$ = GlobalOpts$ + _
  1734.                       ZLibOpts$
  1735.       CALL SortString (SysOpt$)
  1736.       CALL SortString (ZMainOpts$)
  1737.       ZMainOpts$ = ZMainOpts$ + _
  1738.                    SysOpt$
  1739.       CALL SortString (ZFileOpts$)
  1740.       CALL SortString (ZUtilOpts$)
  1741.       CALL SortString (ZLibOpts$)
  1742.       CALL AddCommas (ZMainOpts$)
  1743.       CALL AddCommas (ZFileOpts$)
  1744.       CALL AddCommas (ZUtilOpts$)
  1745.       CALL AddCommas (ZLibOpts$)
  1746.       ZDirPrompt$ = "What directory(s) (" + _
  1747.          MID$("U)pload,A)ll,P)ers,L)ist,E)xtended +/-, [Q]uit)",8 * (ZUserSecLevel => ZMinSecToView) + 9)
  1748.       ZQuitPromptExpert$ = "QUIT C,S, or to F,[M],U,@"
  1749.       ZQuitPromptNovice$ = "QUIT C)onference, S)ession or to section " + _
  1750.                             "F)ile, [M]ain, U)til or @)Library"
  1751.       ZQuitList$ = "FMUS@C"
  1752.       IF ZUserSecLevel < ZOptSec(18) THEN _
  1753.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,23) : _
  1754.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,61) : _
  1755.          MID$(ZQuitList$,5) = " "
  1756.       IF ZUserSecLevel < ZOptSec(15) THEN _
  1757.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,22) + _
  1758.                                MID$(ZQuitPromptExpert$,25) : _
  1759.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,56) + _
  1760.                                MID$(ZQuitPromptNovice$,63) : _
  1761.          MID$(ZQuitList$,3,1) = " "
  1762.       IF ZUserSecLevel < ZOptSec(6) THEN _
  1763.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,16) + _
  1764.                                MID$(ZQuitPromptExpert$,19) : _
  1765.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,41) + _
  1766.                                MID$(ZQuitPromptNovice$,49) : _
  1767.          MID$(ZQuitList$,1,1) = " "
  1768.       CALL SetSection
  1769.       END SUB
  1770. 63480 ' $SUBTITLE: 'NoPath - detects whether string has path'
  1771. ' $PAGE
  1772. '
  1773. '  NAME    -- NoPath
  1774. '
  1775. '  INPUTS  -- Strng$     String to check
  1776. '
  1777. '  OUTPUTS -- HAS.NONE   True if has no path
  1778. '
  1779. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  1780. '             be any
  1781. '
  1782.       SUB NoPath (Strng$,HasPath)                                    ' RM11159302
  1783.       CALL BreakFileName (Strng$,DrvPath$,Prefix$,Ext$,ZFalse)
  1784.       HasPath = (DrvPath$ <> "")
  1785.       END SUB
  1786. 63490 ' $SUBTITLE: 'FindIt - Determine whether file exists'
  1787. ' $PAGE
  1788. '
  1789. '  NAME    -- FindIt
  1790. '
  1791. '  INPUTS  -- FilName$   File name to check
  1792. '
  1793. '  OUTPUTS -- ZOK         True if file exists.  Opened as #2 if does
  1794. '
  1795. '  PURPOSE -- Determine whether file exists and open as standard work
  1796. '             file if it does (#2)
  1797. '
  1798.       SUB FindIt (FilName$)                                          ' RM11159302
  1799.       CALL FindItX (FilName$,2)
  1800.       END SUB
  1801.       SUB ReadParms (AraToUse$(1),NumParms,WhichLine)                ' RM11159302
  1802.       CALL ReadParmsX (2,AraToUse$(),NumParms,WhichLine)
  1803.       END SUB
  1804. 63495 ' $SUBTITLE: 'TimeBack - Give time back to the user'
  1805. ' $PAGE
  1806. '
  1807. '  NAME    -- TimeBack
  1808. '
  1809. '  INPUTS  -- Index    = 1    Set start of time (begin give back)
  1810. '                      = 2    Give back time from defined start
  1811. '
  1812. '  OUTPUTS -- ZTimeCredits!         Number of seconds to credit with
  1813. '             ZSecsPerSession!  Number of seconds in current session
  1814. '
  1815. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  1816. '
  1817.       SUB TimeBack (Index)                                           ' RM11159302
  1818.       IF Index = 1 THEN _
  1819.          CALL TimeRemain (MinsRemaining) : _
  1820.          ZWasQ! = ZSecsUsedSession! : _
  1821.          EXIT SUB
  1822.       CALL TimeRemain (MinsRemaining)
  1823.       WasX! = (ZSecsUsedSession! - ZWasQ!)
  1824.       ZTimeCredits! = ZTimeCredits! + WasX!
  1825.       END SUB
  1826. 63510 ' $SUBTITLE: 'VerifyAns - edits an answer'
  1827. ' $PAGE
  1828. '
  1829. '  NAME    -- VerifyAns
  1830. '                                  MEANING
  1831. '  INPUTS  -- ZVerifying      Whether verifying
  1832. '             ZUserIn$(1)     Response verifying
  1833. '             ZVerifyList$    List of appropriate answers.  1st
  1834. '                                char is what separates answers
  1835. '             ZVerifyNumeric     Verify that is a valid integer
  1836. '                                  if false, then verifying that
  1837. '                                  a string is between 2 values
  1838. '             ZVerifyLow$     Lowest ok value of string
  1839. '             ZVerifyHigh$    Highest ok value of string
  1840. '
  1841. '  OUTPUTS -- ZOK             Whether passes verification
  1842. '             ZVerifyList$    Empties if ok
  1843. '             ZVerifying      Sets false if ok
  1844. '             ZVerifyNumeric  Sets false if ok
  1845. '
  1846. '  PURPOSE -- Processes edits on a user input
  1847. '
  1848.       SUB VerifyAns STATIC
  1849.       ZOK = ZTrue
  1850.       IF NOT ZVerifying THEN _
  1851.          EXIT SUB
  1852.       Temp$ = ZUserIn$(1)
  1853.       CALL AllCaps (Temp$)
  1854.       IF ZVerifyList$ <> "" THEN _
  1855.          WasX$ = LEFT$(ZVerifyList$,1) : _
  1856.          ZOK = (INSTR (ZVerifyList$, WasX$+Temp$+WasX$) > 0) _
  1857.       ELSE IF ZVerifyNumeric THEN _
  1858.               CALL CheckInt (ZUserIn$) : _
  1859.               ZOK = (ZErrCode = 0 AND _
  1860.                     ZTestedIntValue >= VAL(ZVerifyLow$) AND _
  1861.                     ZTestedIntValue <= VAL(ZVerifyHigh$)) _
  1862.            ELSE ZOK = (Temp$ >= ZVerifyLow$ AND Temp$ <= ZVerifyHigh$)
  1863.       IF ZOK THEN _
  1864.          ZVerifyList$ = "" : _
  1865.          ZVerifying = ZFalse : _
  1866.          ZVerifyNumeric = ZFalse
  1867.       END SUB
  1868. 63520 ' $SUBTITLE: 'BinSearch - binary search a file'
  1869. ' $PAGE
  1870. '
  1871. '  NAME    -- BinSearch
  1872. '                                  MEANING
  1873. '  INPUTS  -- PassedSearchFor$  Value you are looking for
  1874. '             StartPos          Starting position of sort key
  1875. '             NumChars          # of characters in sort key
  1876. '             LenRec            Length of record of data file searching
  1877. '             High&             Record # of last record              ' LRGE174/YB102001
  1878. '             ZFastTabs$        In a binary integer subfield (2 bytes)
  1879. '                                  holds 1st record when might find
  1880. '                                  a key beginning with a particular
  1881. '                                  character (0-9,A-Z).   Empty if
  1882. '                                  no Fast Tab exists for the file.
  1883. '
  1884. '  OUTPUTS -- RecFoundAt&       Record # value found at (0 if none)  ' LRGE174/RM112801
  1885. '             RecFound$         Full data record when found
  1886. '
  1887. '  PURPOSE -- Binary searches work file #2 for a key value in a
  1888. '             data file that is sorted on a key field
  1889. '
  1890.       SUB BinSearch (PassedSearchFor$,StartPos,NumChars,LenRec,High&,RecFoundAt&,RecFound$,FilNum) STATIC ' LRGE174/YB102001/RM01229401
  1891.       SearchFor$ = LEFT$(PassedSearchFor$,NumChars)
  1892.       SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$))
  1893.       FIELD FilNum, LenRec AS SearchRec$                             ' RM01229401
  1894.       Low& = 0                                                       ' LRGE174/YB102001
  1895.       IF LEN(ZFastTabs$) < 160 THEN _                                ' TAB174/RM070693
  1896.          GOTO 63522
  1897.       WasX$ = LEFT$(SearchFor$,1)
  1898.       WasX = INSTR("!#$0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_",WasX$) ' TAB174/RM070693
  1899.       IF WasX > 0 THEN _
  1900.          Low& = CVL(MID$(ZFastTabs$,1+4*(WasX-1),4)) - 1 : _         ' LRGE174/YB102001/TAB174/RM070693/0711
  1901.          IF WasX < 40 THEN _                                         ' TAB174
  1902.             High& = CVL(MID$(ZFastTabs$,1+4*WasX,4))                 ' LRGE174/YB102001/TAB174/RM070693/0711
  1903. 63522 RecFoundAt& = 0                                                ' LRGE174/YB102001
  1904.       IF High& < 1 THEN _                                            ' LRGE174/YB102001
  1905.          EXIT SUB
  1906.       WasX$ = SPACE$ (NumChars)
  1907.       Done = ZFalse
  1908.       WHILE NOT Done
  1909.          WasI& = CLNG(INT(((High&/2) + (Low&/2)) + .5))              ' LRGE174/YB102001
  1910.          GET FilNum, WasI&                                           ' LRGE174/YB102001/RM01229401
  1911.          LSET WasX$ = MID$(SearchRec$, StartPos, NumChars)
  1912.          IF WasX$ = SearchFor$ THEN _
  1913.             RecFound$ = SearchRec$: _
  1914.             RecFoundAt& = WasI& : _                                  ' LRGE174/YB102001
  1915.             Done = ZTrue _
  1916.          ELSE IF (High& - Low&) < 2 THEN _                           ' LRGE174/YB102001
  1917.                  Done = ZTrue _
  1918.               ELSE IF WasX$ < SearchFor$ THEN _
  1919.                       Low& = WasI& _                                 ' LRGE174/YB102001
  1920.                    ELSE IF WasX$ > SearchFor$ THEN _
  1921.                            High& = WasI&                             ' LRGE174/YB102001
  1922.       WEND
  1923.       END SUB
  1924. 63530 ' Take modem offhook
  1925.       SUB TakeOffHook                                                ' RM11159302
  1926.       CALL ModemPut (ZModemGoOffHookCmd$)
  1927.       CALL DelayTime (3)
  1928.       END SUB
  1929. 63540 ' Match Name to one in message file
  1930.       SUB ChkMsgName (MsgFromCaller,MsgToCaller) STATIC
  1931.       IF NOT ZRemoteSysop THEN                                       ' DGSALIAS
  1932.          WasX$ = LEFT$("SYSOP",-5*ZSysop)                            ' DGSALIAS
  1933.          CALL MsgNameMatch (ZOrigUserName$,WasX$,6,MsgFromCaller)    ' DGSALIAS
  1934.          CALL MsgNameMatch (ZOrigUserName$,WasX$,37,MsgToCaller)     ' DGSALIAS
  1935.          IF ZAliasMode THEN                                          ' DGSALIAS
  1936.             CALL MsgNameMatch (ZActiveUserName$,WasX$,6,MsgFromCaller) ' DGSALIAS
  1937.             CALL MsgNameMatch (ZActiveUserName$,WasX$,37,MsgToCaller) ' DGSALIAS
  1938.          END IF                                                      ' DGSALIAS
  1939.          EXIT SUB
  1940.       END IF                                                         ' DGSALIAS
  1941.       CALL MsgNameMatch ("SYSOP",ZSysopFullName$,6,MsgFromCaller)
  1942.       IF NOT MsgFromCaller THEN _
  1943.          CALL MsgNameMatch (ZOrigUserName$,"",6,MsgFromCaller)
  1944.       CALL MsgNameMatch ("SYSOP",ZSysopFullName$,37,MsgToCaller)
  1945.       IF NOT MsgToCaller THEN _
  1946.          CALL MsgNameMatch (ZOrigUserName$,"",37,MsgToCaller)
  1947.       END SUB
  1948.       SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC
  1949.       WasX$ = LEFT$(PrimeName$+"  ",22-8*(SearchPos < 7))
  1950.       GOSUB 63542
  1951.       IF Found OR AltName$ = "" THEN _
  1952.          EXIT SUB
  1953.       WasX$ = LEFT$(AltName$ + "  ",22-8*(SearchPos < 7))
  1954.       GOSUB 63542
  1955.       EXIT SUB
  1956. 63542 WasY$ = MID$(ZMsgRec$,SearchPos,LEN(WasX$))
  1957.       ZWasDF = INSTR(WasY$,"@")
  1958.       IF ZWasDF > 0 THEN _
  1959.          MID$(WasY$,ZWasDF) = "      "
  1960.       Found = (WasY$ = WasX$)
  1961.       RETURN
  1962.       END SUB
  1963. 63550 ' Check whether message record is a msg header record
  1964.       SUB ChkIfMsgHeader STATIC
  1965.       ZOK = ZFalse
  1966.       IF MID$(ZMsgRec$,70,1) = "-" AND MID$(ZMsgRec$,73,1) = "-" THEN _
  1967.          WasY = ASC(MID$(ZMsgRec$,116,1)) : _
  1968.          IF WasY > 224 AND WasY < 227 THEN _
  1969.             ZOK = ZTrue
  1970.       END SUB
  1971. 63560 ' Set specified user flag
  1972.       SUB SetUserFlag (RcvrRecNum, ChangeIndex, WhatGetting$) STATIC
  1973.       FIELD #5, 128 AS ZUserRecord$
  1974.       IF RcvrRecNum > 0 THEN _
  1975.          ZUserFileIndex = RcvrRecNum : _
  1976.          ZSubParm = 6 : _
  1977.          CALL FileLock : _
  1978.          GET 5, RcvrRecNum : _
  1979.          WasX = CVI(MID$(ZUserRecord$,57,2)) : _
  1980.          MID$(ZUserRecord$,57,2) = MKI$(WasX OR ChangeIndex) : _
  1981.          PUT 5, RcvrRecNum : _
  1982.          ZSubParm = 8 : _
  1983.          CALL FileLock : _
  1984.          IF NOT ZWelcomeAboard THEN _                                ' NEWU174
  1985.             CALL QuickTPut1 (ZWorkAra$(1) + " will be notified of new " + WhatGetting$) : _ ' NEWU174
  1986.          RcvrRecNum = 0
  1987.       END SUB
  1988. 63580 ' Displays user record
  1989.       SUB DispUserRec (ToPrint) STATIC
  1990.          ZOK = ZFalse
  1991.          WasX$ = MID$(ZUserRecord$,ZStartHash,ZLenHash)
  1992.          IF ASC(WasX$) = 0 OR LEFT$(WasX$,3) = "   " THEN _
  1993.             EXIT SUB
  1994.          WasOF = CVI(ZSecLevel$)
  1995.          IF WasOF > ZUserSecLevel THEN _
  1996.             IF NOT ZGlobalSysop THEN _
  1997.                EXIT SUB
  1998.          ZOutTxt$ = ZFG4$ + RIGHT$("     " + STR$(LOC(5)),4) + _
  1999.               ":" + _
  2000.               ZFG1$ + ZUserName$ + _
  2001.               ZFG2$ + "SECURITY" + _
  2002.               RIGHT$("      " + STR$(WasOF),6) + _
  2003.               " "
  2004.          ZOutTxt$ = ZOutTxt$ + _
  2005.               ZFG3$ + "Password= " + _
  2006.               ZPswd$ + ZEmphasizeOff$
  2007.          GOSUB 63583
  2008.          IF WasOF < ZOrigMainSec THEN _
  2009.             ZOutTxt$ = ZEmphasizeOn$ + "<Locked out>" + ZEmphasizeOff$ + SPACE$(7) _
  2010.          ELSE IF WasOF >= ZSysopSecLevel THEN _
  2011.             ZOutTxt$ = ZEmphasizeOn$ + "  (SysOp)  " + ZEmphasizeOff$ + SPACE$(8) _
  2012.          ELSE ZOutTxt$ = SPACE$(19)
  2013.          ZOutTxt$ = ZOutTxt$ + _
  2014.               ZLastDateTimeOn$ + _
  2015.              "   " + _
  2016.              ZFG4$ + ZCityState$ + ZEmphasizeOff$
  2017.          GOSUB 63583
  2018.          ZOutTxt$ = "  DOWNLOADS = " + _
  2019.              RIGHT$("     " + STR$(CVI(ZUserDnlds$)),5) + _
  2020.              "   " + _
  2021.              "UPLOADS = " + _
  2022.              RIGHT$("     " + STR$(CVI(ZUserUplds$)),5) + _
  2023.              "   " + _
  2024.              " Times on ="
  2025.           ZOutTxt$ = ZOutTxt$ + RIGHT$("     " + STR$(CVI(MID$(ZUserOption$,1,2))),5) + _
  2026.              "   TIME USED= " + _
  2027.              STR$(CVI(ZElapsedTime$)) + _
  2028.              " Min"
  2029.          GOSUB 63583
  2030.          ZOutTxt$ = "  Bank Time : " +_
  2031.             RIGHT$("     " + STR$(ASC(ZBankTime$)),5)
  2032.          ZOutTxt$ = ZOutTxt$ + "   Dropped Carriers : " + _          ' DROP174
  2033.             RIGHT$("     " + STR$(ASC(ZDropTimes$)),5)               ' DROP174
  2034.          GOSUB 63583
  2035.          IF NOT ZEnforceRatios THEN _
  2036.             GOTO 63581
  2037.          ZOutTxt$ = "BYTES: Dwn=" + STR$(CVS(ZDlBytes$)) + _
  2038.               "  Up=" + STR$(CVS(ZULBytes$)) + _
  2039.               " TODAY Dwn: #=" + STR$(CVS(ZTodayDl$)) + _
  2040.               " Bytes=" + STR$(CVS(ZTodayBytes$))
  2041.          GOSUB 63583
  2042. 63581   IF (ZStartIndiv = 0 OR ZLenIndiv = 0) AND _
  2043.            (ZStartHash = 0 OR ZLenHash = 0) AND _
  2044.            NOT ZRestrictByDate THEN _
  2045.               GOTO 63582
  2046.         IF (ZStartHash > 1 AND ZLenHash > 0) THEN _
  2047.            ZOutTxt$ = "Hash: " + MID$(ZUserRecord$,ZStartHash,ZLenHash) _
  2048.         ELSE ZOutTxt$ = ""
  2049.         IF (ZStartIndiv > 1 AND ZLenIndiv > 0) THEN _
  2050.            ZOutTxt$ = ZOutTxt$ + " Indiv: " + MID$(ZUserRecord$,ZStartIndiv,ZLenIndiv)
  2051.         IF ZRestrictByDate THEN _
  2052.             CALL SetRegDisplay : _
  2053.             ZOutTxt$ = ZOutTxt$ + "  Registered: " + _
  2054.                        ZRegDisplayDate$
  2055.         GOSUB 63583
  2056. 63582   ZOK = ZTrue
  2057.         EXIT SUB
  2058. 63583   IF ToPrint THEN _
  2059.             CALL Printit (ZOutTxt$)
  2060.         CALL QuickTPut1 (ZOutTxt$)
  2061.         RETURN
  2062.         END SUB
  2063. 63585 '  *  CALCULATE REGISTRATION DATES
  2064.         ' checks proposed new registration date
  2065.         SUB ResetRegDate (WorkDate$) STATIC ' Formerly 11470
  2066.         IF LEN(WorkDate$) < 10 THEN _
  2067.            WorkDate$ = LEFT$(WorkDate$,6) + _
  2068.                         "19" + _
  2069.                         RIGHT$(WorkDate$,2)
  2070.         ZTodayRegYY = VAL(MID$(WorkDate$,7))
  2071.         ZTodayRegMM = VAL(LEFT$(WorkDate$,2))
  2072.         ZTodayRegDD = VAL(MID$(WorkDate$,4,2))
  2073.         ZOK = ZTodayRegYY > 1979 AND ZTodayRegMM > 0 AND _
  2074.               ZTodayRegMM < 13 AND ZTodayRegDD > 0 AND _
  2075.               ZTodayRegDD < 32
  2076.         IF ZOK THEN _
  2077.            CALL TwoByteDate (ZTodayRegYY,ZTodayRegMM,ZTodayRegDD,ZRegDate$)
  2078.         END SUB
  2079.         ' Sets display of registration date
  2080.         SUB SetRegDisplay STATIC  ' Formerly 11480
  2081.         WasX$ = MID$(ZUserOption$,11,2)
  2082.         IF CVI(WasX$) <> 0 THEN _
  2083.            ZRegDate$ = WasX$ : _
  2084.         ELSE CALL RegToCurrent
  2085.         CALL UnPackDate (ZRegDate$,ZUserRegYY,ZUserRegMM,ZUserRegDD,ZRegDisplayDate$)
  2086.         IF CVI(WasX$) = 0 THEN _
  2087.            ZRegDisplayDate$ = "00-00-00"
  2088.         END SUB
  2089.         ' Sets registration date to current date
  2090.         SUB RegToCurrent           ' Formerly 11482/RM11159302
  2091.         WorkDate$ = DATE$
  2092.         CALL ResetRegDate (WorkDate$)
  2093.         END SUB
  2094. 63590 ' ChangeInt - General routine to get an integer value.
  2095.       '             Calling program has option to show current
  2096.       '             value in prompt (ShowCur) when changing from
  2097.       '             an old value to a new one, passing current
  2098.       '             value in CurVal.   Txt$ is part of prompt that
  2099.       '             calling program contributes.  Is whole prompt
  2100.       '             if not showing old value, otherwise is just
  2101.       '             description of what value represents.
  2102.       '                 Pass the inclusive minimum values (MinVal)
  2103.       '             and maximum values (MaxVal).
  2104.       '                 Returns the value gotten in ZTestedIntValue.
  2105.       '
  2106.       SUB ChangeInt (ShowCur,Txt$,CurVal,MinVal,MaxVal) STATIC
  2107.       IF ZAnsIndex < ZLastIndex THEN _
  2108.          GOTO 63594
  2109. 63592 IF Showcur THEN _
  2110.          CALL QuickTPut ("Change ",0) : _
  2111.          CALL QuickTPut (Txt$,0) : _
  2112.          CALL QuickTPut (" from ",0) : _
  2113.          CALL QuickTPut (STR$(CurVal),0) : _
  2114.          CALL QuickTPut (" to (",0) _
  2115.       ELSE CALL QuickTPut (Txt$,0) : _
  2116.            CALL QuickTPut (" (",0)
  2117.       IF ZGetExtDesc THEN _                                          ' BC-DESC/RM012601
  2118.          CALL QuickTPut (STR$(MinVal + 1),0) _                       ' BC-DESC/RM012601
  2119.       ELSE _                                                         ' BC-DESC/RM012601
  2120.          CALL QuickTPut (STR$(MinVal),0)
  2121.       CALL QuickTPut (" -",0)
  2122.       IF ZGetExtDesc THEN _                                          ' BC-DESC/RM012601
  2123.          CALL QuickTPut (STR$(MaxVal + 1),0) _                       ' BC-DESC/RM012601
  2124.       ELSE _                                                         ' BC-DESC/RM012601
  2125.          CALL QuickTPut (STR$(MaxVal),0)
  2126.       ZOutTxt$ = ", [Q]uit)"
  2127. 63594 CALL PopCmdStack
  2128.       Temp$ = ZUserIn$(ZAnsIndex)
  2129.       CALL AllCaps (Temp$)
  2130.       CALL Trim (Temp$)
  2131.       IF ZSubParm > -1 AND Temp$ <> "Q" AND ZWasQ <> 0 THEN _
  2132.          GOTO 63595
  2133.       ZWasQ = 0
  2134.       IF ShowCur THEN _
  2135.          CALL QuickTPut1 ("Unchanged")
  2136.       EXIT SUB
  2137. 63595 IF ZGetExtDesc THEN _                                          ' BC-DESC/RM012601
  2138.          CALL CheckInt (STR$(VAL(Temp$) - 1)) _                      ' BC-DESC/RM012601
  2139.       ELSE _                                                         ' BC-DESC/RM012601
  2140.          CALL CheckInt (Temp$)                                       ' BC-DESC/RM012601 63595
  2141.       IF ZTestedIntValue < MinVal OR ZTestedIntValue > MaxVal THEN _
  2142.          ZLastIndex = 0 : _
  2143.          CALL QuickTPut1 ("Min " + STR$(MinVal) + ", Max " + STR$(MaxVal)) : _
  2144.          GOTO 63592
  2145.       IF ShowCur THEN _
  2146.          CALL QuickTPut1 ("Set to " + STR$(ZTestedIntValue))
  2147.       END SUB
  2148. 63600 ' MarkItems - Converts a list of items ZUserIn$(), items ZAnsIndex
  2149.       '             thru ZLastIndex, into a marked list MarkedList$.
  2150.       '
  2151.       ' Will also check for the existance of the file, for security breech,
  2152.       ' display a macro if one applies, and display to the user the filename,
  2153.       ' filesize and approximate time to download the file
  2154.       '
  2155.       SUB MarkItems (IsMarking,MarkedList$,MarkedDesc$,PersonalDnld) ' RM01209401
  2156.       IF NOT IsMarking THEN _
  2157.          EXIT SUB
  2158.       IF ZFileSysParm < 1 THEN                                       ' DGS101001-DS
  2159.          FOR MarkNum = ZAnsIndex to ZLastIndex                       ' DGS101001-DS
  2160.             MarkedList$ = MarkedList$ + ZUserIn$(MarkNum) + ZCarriageReturn$ ' DGS101001-DS
  2161.          NEXT                                                        ' DGS101001-DS
  2162.          CALL ReportMarked (MarkedList$,MarkedDesc$)                 ' DGS101001-DS
  2163.          EXIT SUB                                                    ' DGS101001-DS/RM01069401
  2164.       END IF                                                         ' DGS101001-DS
  2165.       FirstMark = ZFalse                                             ' RM02019401
  2166.       IF MarkedList$ = "" THEN _                                     ' RM02019401
  2167.          FirstMark = ZTrue                                           ' RM02019401
  2168.       DidTitle = ZFalse                                              ' DGS092201-DS
  2169.       IF MarkedDesc$ = "wild" THEN                                   ' DGS101602-DS/RM03129401
  2170.          WildName$ = ZNodeWorkDrvPath$ + "WILD" + ZNodeId$ + ".DEF"
  2171.          FilNum = FREEFILE                                           ' RM03129401
  2172.          CALL OpenRand2 (WildName$,13,FilNum)                        ' DGS101602-DS/RM03129401/RM03279401
  2173.          FIELD FilNum,12 AS WildFileName$, _                         ' DGS101602-DS/RM03129401
  2174.                        1 AS WildCr$                                  ' DGS101602-DS
  2175.          HighRec = LOF(FilNum)\13                                    ' RM03279401
  2176.       END IF                                                         ' DGS101602-DS/RM03129401
  2177.       FOR Temp = ZAnsIndex to ZLastIndex                             ' DGS092201-DS
  2178.          IF MarkedDesc$ = "wild" THEN                                ' DGS101602-DS
  2179.             IF ABS(INT(VAL(ZUserIn$(Temp)))) > HighRec THEN _        ' RM03279401/RM04069402
  2180.                CALL QuickTPut1 (ZFG5$ + "No such file number " + ZFG7$ + _
  2181.                                   ZUserIn$(Temp) + ZEmphasizeOff$) : _ ' RM03279401
  2182.                GOTO 63603                                            ' RM03279401
  2183.             GET FilNum,ABS(INT(VAL(ZUserIn$(Temp))))                 ' DGS101602-DS/RM03129401/RM04069402
  2184.             MarkFileName$ = WildFileName$                            ' DGS101602-DS
  2185.             CALL Trim(MarkFileName$)                                 ' DGS101602-DS
  2186.          ELSE                                                        ' DGS101602-DS
  2187.             MarkFileName$ = UCASE$(ZUserIn$(Temp))                   ' DGS101602-DS/RM01139401
  2188.          END IF                                                      ' DGS101602-DS
  2189.          CALL Carrier                                                ' RM/GS02129401
  2190.          IF ZSubParm = -1 THEN                                       ' RM/GS02129401
  2191.             IF MarkedDesc$ = "wild" THEN _                           ' RM03129401
  2192.                CLOSE FilNum                                          ' RM03129401
  2193.             EXIT SUB                                                 ' RM/GS02129401
  2194.          END IF                                                      ' RM03129401
  2195.          MarkingTime = ZFalse                                        ' DGS092201-DS
  2196.          MarkFileNameHold$ = MarkFileName$                           ' RM01269401
  2197.          ZFileName$ = MarkFileNameHold$                              ' RM01269401
  2198.          IF INSTR(MarkedList$,MarkFileName$) > 0 THEN _              ' RM01049401/RM01139401
  2199.             CALL QuickTPut1 (ZFG7$ + MarkFileName$ + ZFG5$ + " is already " + _
  2200.                              "marked for download!" + ZEmphasizeOff$) : _ ' RM01049401/RM01139401
  2201.             GOTO 63603                                               ' RM01049401
  2202.          CALL Remove (MarkFileName$,", ")                            ' RM01049401/RM01139401
  2203.          IF INSTR(MarkFileName$,".") = 0 THEN _                      ' DS101602-DS/RM01139401
  2204.             MarkFileNameAlt$ = MarkFileName$ : _                     '             /RM01269401
  2205.             MarkFileName$ = MarkFileName$ + "." + ZDefaultExtension$ _ ' DGS101602-DS/RM01139401
  2206.          ELSE _                                                      ' RM01269401
  2207.             MarkFileNameAlt$ = ""
  2208.          CALL BadFile (MarkFileName$,BadFileNameIndex)               ' RM01049401/RM01139401
  2209.          ON BadFileNameIndex GOTO 63601,63602,63604                  ' RM01049401
  2210. 63601    CALL RotorsDir (MarkFileName$,ZSubDir$(),ZSubDirCount + _   ' DGS101602-DS/RM01139401
  2211.                          ((ZUserSecLevel < ZMinSecToView) OR _       ' DGS101602-DS
  2212.                           NOT ZCanDnldFromUp),MarkingTime,"D")       ' DGS092201-DS/RM01049401
  2213.          IF ZAbort OR ZDotFlag THEN _                                ' RM03219401/RM04099401
  2214.             ZAbort = ZFalse : _                                      ' RM03219401
  2215.             GOTO 63603                                               ' RM03219401
  2216.          CALL BreakFileName (MarkFileName$,Dr$,WasY$,WasX$,ZTrue)    ' RM01209401
  2217.          IF NOT ZOK AND PersonalDnld THEN _                          ' RM01209401
  2218.             MarkFileName$ = ZPersonalDrvPath$ + WasY$ + WasX$ : _    ' RM01209401
  2219.             CALL FindFile (MarkFileName$,ZOK)                        ' RM01209401
  2220.          IF ZOK THEN                                                 ' DGS092201-DS
  2221.             IF NOT DidTitle THEN _                                   ' DGS092201-DS/RM01069401
  2222.                CALL MarkFileHeader : _                               ' RM01069401
  2223.                DidTitle = ZTrue                                      ' RM01069401
  2224.             CALL FormatMarkedFileDisplay (MarkFileName$,WasY$ + WasX$,FirstMark) ' RM01049401/RM01139401/RM01229401/RM02019401
  2225.             MarkedList$ = MarkedList$ + WasY$ + WasX$ + ZCarriageReturn$ ' DGS092201-DS/RM01229401
  2226.             FirstMark = ZFalse                                       ' RM02059402
  2227.             GOTO 63603                                               ' RM01049401
  2228.          ELSE                                                        ' DGS101001-DS
  2229.             IF MarkFileNameAlt$ <> "" THEN _                         ' RM01049401/RM01269401
  2230.                MarkFileName$ = MarkFileNameAlt$ : _                  ' RM01049401/RM01139401
  2231.                MarkFileNameAlt$ = "" : _                             ' RM01049401/RM01269401
  2232.                GOTO 63601                                            ' RM01049401
  2233. 63602       ZOutTxt$ = ZFGC$ + MarkFileNameHold$ + ZFGF$ + " not found!" + _ ' DGS101603-DS/RM01139401/RM01269401
  2234.                      " Correct name" + ZPressEnterExpert$ + ZEmphasizeOff$ ' DGS101603-DS
  2235.             ZSuspendAutoLogoff = ZFalse                              ' RM01049401
  2236.             ZSubParm = 1                                             ' DGS101001-DS
  2237.             CALL TGet                                                ' DGS101001-DS
  2238.             IF ZSubParm < 0 THEN                                     ' DGS101001-DS
  2239.                ZFileSysParm = 2                                      ' DGS101001-DS
  2240.                IF MarkedDesc$ = "wild" THEN _                        ' RM03129401
  2241.                   CLOSE FilNum                                       ' RM03129401
  2242.                EXIT SUB                                              ' RM01049401
  2243.             END IF                                                   ' RM03129401
  2244.             IF ZWasQ = 0 THEN _                                      ' RM01049401
  2245.                GOTO 63603                                            ' RM01049401
  2246.             ZUserIn$(Temp) = ZUserIn$(1)                             ' DGS101001-DS/RM01049401
  2247.             Temp = Temp - 1                                          ' RM01049401
  2248.          END IF                                                      ' DGS101001-DS
  2249. 63603 NEXT                                                           ' DGS101001-DS
  2250.       IF MarkedDesc$ = "wild" THEN _                                 ' DGS011601-DS
  2251.          CLOSE FilNum                                                ' DGS011601-DS/RM03129401
  2252.       CALL ReportMarked (MarkedList$,MarkedDesc$)
  2253.       EXIT SUB                                                       ' DGS092201-DS
  2254. 63604 ZViolation$ = "Marking File " + MarkFileName$                  ' RM01049401/RM01139401
  2255.       CALL SecViolation                                              ' RM01049401
  2256.       IF ZDenyAccess THEN _                                          ' RM01049401
  2257.          ZFileSysParm = 4 : _                                        ' RM01049401
  2258.          EXIT SUB                                                    ' RM01049401
  2259.       GOTO 63602                                                     ' RM01049401
  2260.       END SUB
  2261. '
  2262.       SUB FormatMarkedFileDisplay (FilName$,DFilName$,FirstMark) STATIC ' RM01049401/RM02019401
  2263.       IF ZUserXferDefault$ = "N" THEN                                ' DGS091701-DS/DGS03129401-DS
  2264.          ZSpeedFactor! = .95        ' Most use Zmodem Nowadays for this calc ' DGS091701-DS
  2265.          ZFLen = 1024                                                ' DGS091701-DS
  2266.       END IF                                                         ' DGS101001-DS
  2267.       IF FirstMark THEN _                                            ' RM02019401
  2268.          TotBlocks# = 0                                              ' RM02019401
  2269.       FilNum = FREEFILE                                              ' RM03129401
  2270.       CALL OpenRSeq (FilName$,MaxBlock&,LenLastRec,ZFLen,FilNum)     ' RM01139401/RM03129401
  2271.       DGSBytesInFile# = LOF(FilNum)                                  ' DGS091701-DS/RM03129401
  2272.       CLOSE FilNum                                                   ' DGS091701-DS/RM01049401/RM03129401
  2273.       DGSBlocksInFile# = MaxBlock&                                   ' DGS091701-DS/01049401
  2274.       Blocks# = DGSBlocksInFile# / _                                 ' DGS091701-DS
  2275.          VAL(MID$("00000300045012002400480072009601200144016801920216024002640288038405760", -4 * ZCBPS, 4)) ' BB08219301/BB09039301/RM11279301
  2276.       Blocks# = Blocks# * ZFLen / ZSpeedFactor!                      ' MARK174' DGS091701-DS
  2277.       TotBlocks# = TotBlocks# + Blocks#
  2278.       Estimate$ = RIGHT$(SPACE$(5) + STR$(INT(Blocks#/60)),5) + ":" + _  ' DGS091701-DS
  2279.                   RIGHT$(STRING$(2,48) + _                               ' DGS091701-DS
  2280.                   LTRIM$(STR$(INT(Blocks#-(INT(Blocks# / 60) * 60)))),2) ' MARK174 ' DGS091701-DS
  2281.       Estimate2$ = RIGHT$(SPACE$(5) + STR$(INT(TotBlocks#/60)),5) + ":" + _  ' DGS091701-DS
  2282.                    RIGHT$(STRING$(2,48) + _                               ' DGS091701-DS
  2283.                    LTRIM$(STR$(INT(TotBlocks#-(INT(TotBlocks# / 60) * 60)))),2) ' MARK174 ' DGS091701-DS
  2284.       MBodyTxt$ = ZFG4$ + DFilName$ + _                              ' DGS091701-DS
  2285.                  SPACE$(14-LEN(DFilName$)) + _                       ' DGS091701-DS
  2286.                  ZFG4$ + STR$(DGSBytesInFile#) + _                   ' DGS091701-DS
  2287.                  SPACE$(12-LEN(STR$(DGSBytesInFile#))) + _           ' DGS091701-DS
  2288.                  ZFG4$ + Estimate$ + _                               ' MARK174/RM05199301/DGS101603-DS
  2289.                  SPACE$(17-LEN(Estimate$)) + _                       ' DGS101603-DS
  2290.                  ZFG4$ + Estimate2$ + ZEmphasizeOff$                 ' MARK174/RM05199301/DGS101603-DS/01049401/RM01069401
  2291.       CALL QuickTPut1 (MBodyTxt$)                                    ' RM01099401
  2292.       END SUB                                                        ' DGS091701-DS
  2293. '
  2294.       SUB MarkFileHeader                                             ' RM01049401
  2295.       MHedrTxt$ = ZFG1$ + "                            Approx.      Approx. Total" ' DGS091701-DS
  2296.       CALL QuickTPut1 (MHedrTxt$)                                    ' RM01139403
  2297.       MHedrTxt$ = ZFG1$ + "FileName       Bytes        DL Time          DL Time  " ' DGS091701-DS/RM01139403
  2298.       CALL QuickTPut1 (MHedrTxt$)                                    ' RM01139403
  2299.       MHedrTxt$ = ZFG2$ + "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" + _  ' DGS091701-DS
  2300.                   ZEmphasizeOff$                                     ' yb040193
  2301.       CALL QuickTPut1 (MHedrTxt$)                                    ' RM01069401
  2302.       END SUB                                                        ' RM01049401
  2303. '
  2304.       SUB ReportMarked (MarkedList$,ListDesc$) STATIC
  2305.       CALL FindLast (MarkedList$,ZCarriageReturn$,Temp,ZLastIndex)
  2306.       CALL QuickTPut1 (ZFG7$ + STR$(ZLastIndex) + " " + ZFG5$ + _
  2307.                      ListDesc$ + "(s) now marked" + ZEmphasizeOff$)  ' DGS091701-DS
  2308.       CALL SkipLine (1)                                              ' RM01179401
  2309.       ZLastIndex = 0
  2310.       END SUB
  2311. 63605 ' AskItems - general routine for asking for a list of items.
  2312.       '            Calling program instructs what the valid commands
  2313.       '            are (ValidCmnd$), what the actual user command is
  2314.       '            (UserCmnd$), and whether to Mark the items.  Returns
  2315.       '            list of items in ZUserIn$().   Supports lists for viewing,
  2316.       '            downloading, and marking.   Gives option to operate
  2317.       '            on marked when items have been previously marked.
  2318.       '                Calling program tells what to mark (MarkedItems$)
  2319.       '            and how to describe the items gathering (ItemDesc$).
  2320.       '
  2321.       SUB AskItems (ValidCmnd$,UserCmnd$,DoMark,ItemDesc$,MarkedItems$,PersonalDnld) ' RM01209401/RM03279401
  2322.       CALL AllCaps (UserCmnd$)
  2323.       Temp = INSTR(ValidCmnd$,UserCmnd$)
  2324.       IF Temp = 0 OR UserCmnd$ = "" THEN _
  2325.          EXIT SUB
  2326.       IF UserCmnd$ = "W" THEN _
  2327.          CALL MarkItems (ZTrue,MarkedItems$,ItemDesc$,PersonalDnld) : _ ' RM01209401
  2328.          EXIT SUB
  2329.       Temp = INSTR("VDMU",UserCmnd$)                                 ' BTCH174
  2330.       ZOutTxt$ = MID$("ViewDnldMarkUpld",4*Temp-3,4) + " what " + ItemDesc$ + "(s)" ' BTCH174
  2331.       IF Temp = 2 AND ZWildDownOK AND NOT ZPersonalDnld THEN _          ' DD031803/WILD
  2332.          ZOutTxt$ = ZOutTxt$ + " (WildCard '*' OK)"                     ' DD030301/WILD
  2333.       IF Temp < 3 THEN IF MarkedItems$ <> "" THEN _
  2334.          ZoutTxt$ = ZOutTxt$ + ", M)arked"
  2335.       ZStackC = ZTrue
  2336.       CALL PopCmdStack
  2337.       IF ZWasQ > 0 AND DoMark AND Temp = 3 THEN _
  2338.          CALL MarkItems (ZTrue,MarkedItems$,ItemDesc$,PersonalDnld)  ' RM01209401
  2339.       END SUB
  2340. 63610 ' UnMarkItems - takes an input (ZWasZ$), on input item number
  2341.       '               "OnItem", where number of last of the inputs
  2342.       '               is "LastItem", determines whether the option
  2343.       '               is one for marked items, and inserts any marked
  2344.       '               items in MarkedList$ into the input stream (ZUserIn$())
  2345.       '               at the item number (OnItem).  Reports
  2346.       '               whether found marked (FoundMarked),
  2347.       '               and if calling programs says to reinitialize
  2348.       '               the marked items (ReInit), empties the
  2349.       '               list of marked items (MarkedList$) when they
  2350.       '               are found.
  2351.       '
  2352.       SUB UnMarkItems (MarkedList$,OnItem, LastItem, FoundMarked,ReInit) STATIC
  2353.       FoundMarked = ZFalse
  2354.       CALL AllCaps (ZWasZ$)
  2355.       IF MarkedList$ <> "" THEN IF ZWasZ$ ="M" THEN _
  2356.          FoundMarked = ZTrue : _
  2357.          EndFile = LEN (MarkedList$) : _
  2358.          Temp = INSTR(MarkedList$,ZCarriageReturn$) : _
  2359.          ZUserIn$(OnItem) = MID$(MarkedList$,1,Temp-1) : _
  2360.          StartFile = Temp + 1 : _
  2361.          InsertAt = OnItem + 1 : _
  2362.          WHILE StartFile < EndFile : _
  2363.             Temp = INSTR(StartFile,MarkedList$,ZCarriageReturn$) : _
  2364.             FOR X = LastItem TO InsertAt STEP -1 : _
  2365.                ZUserIn$(X + 1) = ZUserIn$(X) : _
  2366.             NEXT : _
  2367.             LastItem = LastItem + 1 : _
  2368.             ZUserIn$(InsertAt) = MID$(MarkedList$,StartFile,Temp-StartFile) : _
  2369.             InsertAt = InsertAt + 1 : _
  2370.             StartFile = Temp + 1 : _
  2371.          WEND : _
  2372.          IF ReInit THEN _
  2373.             MarkedList$ = ""
  2374.       END SUB
  2375. 63615 ' * Sets up next message base link *
  2376.       SUB NextConf (DoJoin) STATIC
  2377.       IF ZLinkedConf$ = "" OR (NOT DoJoin) THEN _
  2378.          EXIT SUB
  2379. 63616 EndConf = INSTR(ZLinkedConf$,ZCarriageReturn$)                 ' KG013001
  2380.       LastConf = (EndConf = LEN(ZLinkedConf$))                       ' KG013001
  2381.       ZHomeConf$ = LEFT$(ZLinkedConf$,EndConf-1)
  2382.       IF ZNonStop THEN _
  2383.          CALL QuickTPut1 ("Joining linked conference " + ZHomeConf$) _
  2384.       ELSE _
  2385.          ZOutTxt$ = "Continue to linked conference " + ZHomeConf$ + " ([Y],S)kip,A)bort)" : _ ' KG020801
  2386.          CALL DeLink (ZHomeConf$) : _                                ' KG013001
  2387.          ZTurboKey = -ZTurboKeyUser : _
  2388.          ZSubParm = 1 : _
  2389.          CALL TGet : _
  2390.          IF ZWasQ > 0 AND NOT ZYes THEN _                            ' KG020801
  2391.             ZWasX$ = ZUserIn$(1) : _                                 ' KG013001
  2392.             CALL AllCaps (ZWasX$) : _                                ' KG013001
  2393.             ZLinkedConf$ = ZLinkedConf$ + ZHomeConf$ + ZCarriageReturn$ : _ ' KG013001
  2394.             IF LastConf OR ZWasX$ = "A" THEN _                       ' KG013001
  2395.                ZHomeConf$ = ""  : _                                  ' KG013001             ' KG013001
  2396.                ZGlobalRead = ZFalse : _                              ' KG013001
  2397.                EXIT SUB _                                            ' KG013001
  2398.             ELSE GOTO 63616                                          ' KG013001
  2399.       END SUB
  2400. 63620 ' * Adds/Deletes a new link to conference link list *
  2401.       SUB AddLink (Conf$)                                            ' RM03309401
  2402.       IF INSTR(ZCarriageReturn$+ZLinkedConf$,ZCarriageReturn$+Conf$+ZCarriageReturn$) THEN _
  2403.          EXIT SUB
  2404.       ZLinkedConf$ = ZLinkedConf$ + Conf$ + ZCarriageReturn$
  2405.       END SUB
  2406.       SUB DeLink (Conf$)                                             ' RM03309401
  2407.       Temp = INSTR(ZCarriageReturn$+ZLinkedConf$,ZCarriageReturn$+Conf$+ZCarriageReturn$)
  2408.       IF Temp > 0 THEN _
  2409.          Temp = Temp - 1 : _
  2410.          ZLinkedConf$ = LEFT$(ZLinkedConf$,Temp) + RIGHT$(ZLinkedConf$,LEN(ZLinkedConf$)-Temp-LEN(Conf$)-1)
  2411.       END SUB
  2412. 63625 ' * Sets SysOp security variables Formerly 5370 of rbbs-pc.bas
  2413.       ' * Returns ZWasA true when remote or global sysop
  2414.       SUB SetSysOp                                                   ' RM03309401
  2415.       ZRemoteSysop = ((ZActiveUserName$ = ZSecretName$) OR _
  2416.                       (ZOrigUserName$ = ZSecretName$))
  2417.       ZWasA = ZRemoteSysop
  2418.       ZGlobalSysop = (ZGlobalSysop OR (ZWasA AND ZOrigCnfg$ = ZConfigFileName$))
  2419.       IF ZGlobalSysop THEN _
  2420.          ZWasA = ZTrue
  2421.       END SUB
  2422. 63630 ' * Sets the user preferences based on user record.
  2423.       ' * Formerly in RBBS-PC.BAS
  2424.       SUB SetUserPref STATIC
  2425.       IF ZWasA THEN _
  2426.          ZUserSecLevel = ZSysopSecLevel _
  2427.       ELSE ZUserSecLevel = CVI(ZSecLevel$)
  2428.       ZDropTimes = ASC(ZDropTimes$)                                  ' DROP174
  2429.       ZBankTime = ASC(ZBankTime$)
  2430.       ZLastMsgRead = CVI(MID$(ZUserOption$,3,2))
  2431.       ZUserXferDefault$ = MID$(ZUserOption$,5,1)
  2432.       IF ZUserXferDefault$ = " " THEN _
  2433.          ZUserXferDefault$ = "N"
  2434.       CALL XferType (2,ZTrue)
  2435.       WasX = ASC(MID$(ZUserOption$,6,1))
  2436.       ZWasGR = (WasX MOD 3)
  2437.       ZBoldText$ = CHR$(48 - (WasX > 50))
  2438.       ZUserTextColor = (WasX - ZWasGR)/3 + 21
  2439.       IF ZUserTextColor > 37 THEN _
  2440.          ZUserTextColor = ZUserTextColor - 7
  2441.       IF ZEmphasizeOff$ <> "" THEN _
  2442.          CALL QuickTPut (ZColorReset$,0)
  2443.       IF ZEmphasizeOnDef$ <> "" THEN _
  2444.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m" _
  2445.       ELSE ZEmphasizeOff$ = ""
  2446.       IF ZWasGR = 1 AND NOT ZEightBit THEN _
  2447.          ZWasGR = 0
  2448.       CALL SetGraphic (ZWasGR)
  2449.       ZRightMargin = CVI(MID$(ZUserOption$,7,2))
  2450.       IF ZRightMargin > 72 THEN _
  2451.          ZRightMargin = 72
  2452.       IF NOT ZConfMode THEN _
  2453.          ZWasCI$ = ZCityState$ : _
  2454.          CALL Trim (ZWasCI$)
  2455.       UserOptions = CVI(MID$(ZUserOption$,9,2))
  2456.       ZPromptBell = (UserOptions AND 1) > 0
  2457.       ZExpertUser = (UserOptions AND 2) > 0
  2458.       CALL SetExpert
  2459.       ZNulls = (UserOptions AND 4) > 0
  2460.       ZUpperCase = (UserOptions AND 8) > 0
  2461.       ZLineFeeds = (UserOptions AND 16) > 0
  2462.       ZCheckBulletLogon = (UserOptions AND 32) > 0
  2463.       ZSkipFilesLogon = (UserOptions AND 64) > 0
  2464.       ZAutoDownDesired = (UserOptions AND 128) > 0
  2465.       ZReqQuesAnswered = (UserOptions AND 256) > 0
  2466.       ZMailWaiting = (UserOptions AND 512) > 0
  2467.       WasX = (UserOptions AND 1024 ) > 0
  2468.       CALL SetHiLite (NOT WasX)
  2469.       IF NOT ZHiLiteOff THEN _
  2470.          CALL QuickTPut (ZEmphasizeOff$,0)
  2471.       ZTurboKeyUser = (UserOptions AND 2048) > 0
  2472.       ZTurboKey = ZFalse
  2473.       ZFileWaiting = (UserOptions AND 4096) > 0
  2474.       ZAvailableForChat = (UserOptions AND 8192) > 0                 ' RCHAT401
  2475.       CALL SetRegDisplay
  2476.       ZPageLength = ASC(MID$(ZUserOption$,13,1))
  2477.       IF ZSubBoard THEN _
  2478.          GOTO 63632
  2479.       WasX$ = ZEchoer$
  2480.       ZEchoer$ = MID$(ZUserOption$,14,1)
  2481.       IF INSTR("ICR",ZEchoer$) = 0 THEN _
  2482.          ZEchoer$ = "R"
  2483.       IF WasX$ <> ZEchoer$ THEN _
  2484.          CALL ReportEcho
  2485.       CALL SetEcho (ZEchoer$)
  2486. 63632 ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
  2487.       CALL SetCrLf
  2488.       ZUseTPut = (ZUpperCase OR ZXOnXOff)
  2489.       ZPswdSave$ = ZPswd$
  2490.       END SUB
  2491. 63635 ' * Reports who is doing echoing.  Formerly 9525 of rbbs-pc.bas
  2492.       SUB ReportEcho                                                 ' RM11159302
  2493.       IF ZEchoer$ = "R" THEN _
  2494.          ZOutTxt$ =  "RBBS now set" _
  2495.       ELSE IF ZEchoer$ = "C" THEN _
  2496.               ZOutTxt$ = "Please set your communications package" _
  2497.            ELSE ZOutTxt$ = "Intermediate host now set"
  2498.       CALL QuickTPut1 (ZOutTxt$ + " to echo what you type")
  2499.       END SUB
  2500. 63640 ' * Welcomes caller on
  2501.       SUB SayWelcome                                                 ' RM03309401
  2502.       LOCATE 24,1
  2503.       CALL AMorPM
  2504.       ZUserLogonTime! = TIMER
  2505.       ZTimeLoggedOn$ = TIME$
  2506.       ZLinesPrinted = 0
  2507.       ZExpertUser = ZFalse
  2508.       CALL SetExpert
  2509.       ZOutTxt$ = ""
  2510.       IF ZMaxNodes > 1 THEN _
  2511.          ZOutTxt$ = " - Node " + ZNodeID$
  2512.       ZOutTxt$ = ZOutTxt$ + " - connected at " + ZCBaud$ + " bps"    ' RM08229302
  2513.       IF ZReliableMode THEN _
  2514.          ZOutTxt$ = ZOutTxt$ + " (Reliable)"
  2515.       CALL QuickTPut1 ("Welcome to " + ZRBBSName$ + ZOutTxt$)
  2516.       CALL TestANSI
  2517.       ZTestParity = ZTrue
  2518.       ZStopInterrupts = ZTrue
  2519.       ZFileName$ = ZPreLog$
  2520.       CALL FlushCom (WasX$)
  2521.       ZCommPortStack$ = ""
  2522.       END SUB
  2523. 63645 ' * computes the session time.  Formerly 825 in rbbs-pc.bas
  2524.       SUB SetSessionTime STATIC
  2525.       WasX = (ZMaxPerDay - ZMinsPerSession)
  2526.       WasX = -WasX * (WasX > 0)    ' extra from daily max
  2527.       ZWasQ! = WasX + ZMinsPerSession + (ZMaxPerDay > 0) * ZElapsedTime
  2528.       IF ZWasQ! > ZMinsPerSession AND ZElapsedTime >= 0 THEN _
  2529.          ZWasQ! = ZMinsPerSession
  2530.       ZSecsPerSession! = ZWasQ! * 60 + ZTimeCredits!
  2531.       END SUB
  2532. 63650 ' * Sets privileges based on PASSWRDS file
  2533.       ' * Formerly 5135-5160 in RBBS-PC.BAS
  2534.       SUB SetPrivileges STATIC
  2535.       ZWasZ$ = ""
  2536.       CALL SrchPasswrds (Found)
  2537.       IF NOT Found THEN _
  2538.          ZTempTimeAllowed = ZMinsPerSessionDef : _
  2539.          ZTempMaxPerDay = ZMaxPerDayDef : _
  2540.          ZTempExpiredSec = ZExpiredSec : _
  2541.          ZMaxBank = ZMaxBankTimeDef _
  2542.       ELSE ZTimeLockSet = ZTempTimeLock : _
  2543.            ZDaysInRegPeriod = ZTempRegPeriod : _
  2544.            ZMaxBank = ZTempMaxBank
  2545.       ZMinsPerSession = ZTempTimeAllowed
  2546.       ZMaxPerDay = -(ZMaxPerDay * (ZTempMaxPerDay <= 0)) - _
  2547.                      (ZTempMaxPerDay * (ZTempMaxPerDay > 0))
  2548.       IF ZLimitMinsPerSession THEN _
  2549.          IF ZMinsPerSession > ZLimitMinsPerSession THEN _
  2550.             ZMinsPerSession = ZLimitMinsPerSession : _
  2551.             ZOutTxt$ = "Time shortened for external event" : _
  2552.             CALL RingCaller
  2553.       CALL SetSessionTime
  2554.       END SUB
  2555. 63652 ' * Searches file ZPswdFile$, looking for match to
  2556.       ' * ZWasZ$.  Returns whether found in "Found" and sets
  2557.       ' * varibles read in by GetPassword
  2558.       '
  2559.       SUB SrchPasswrds (Found) STATIC
  2560.       Found = ZFalse
  2561.       GOSUB 63665                                                    ' RM01159402
  2562.       CALL ReadDir (2,1)                                             ' RM01159402
  2563.       CALL FindLast (ZOutTxt$,",",WhereFound,NumFinds)               ' RM01159402
  2564.       NumFinds = NumFinds + 1                                        ' RM01159402
  2565.       CLOSE 2                                                        ' RM01159402
  2566.       GOSUB 63665                                                    ' RM01159402
  2567.       MatchPass$ = ZWasZ$
  2568.       IF MatchPass$ <> "" THEN _
  2569.          MatchPass$ = LEFT$(MatchPass$ + SPACE$(15),15)
  2570.       MatchPass = (MatchPass$ <> "")
  2571. 63654 IF EOF(2) THEN _
  2572.          GOTO 63659
  2573. 63656 CALL GetPassword (NumFinds)                                    ' RM01159402
  2574.       IF ZErrCode <> 0 THEN _
  2575.          CALL UpdtCalr (ZPswdFile$ + " bad format!",2) : _
  2576.          GOTO 63659
  2577.       IF MatchPass THEN _
  2578.          ZTempPassword$ = LEFT$(ZTempPassword$ + SPACE$(15),15) : _
  2579.          IF MatchPass$ <> ZTempPassword$ THEN _
  2580.             GOTO 63654 _
  2581.          ELSE IF ZUserSecLevel >= ZMinSecForTempPswd THEN _
  2582.                  GOTO 63658 _
  2583.               ELSE GOTO 63654
  2584.       IF ZUserSecLevel <> ZTempSecLevel OR ZTempPassword$ <> "" THEN _
  2585.          GOTO 63654
  2586.       IF ZStartTime = 0 THEN _
  2587.          GOTO 63658
  2588.       WorkTime$ = TIME$
  2589.       TestTime = VAL(LEFT$(WorkTime$,2) + MID$(WorkTime$,4,2))
  2590.       IF TestTime => ZStartTime AND TestTime <= ZEndTime THEN _
  2591.          GOTO 63658
  2592.       IF ZEndTime < ZStartTime THEN _
  2593.          IF TestTime => ZStartTime OR TestTime <= ZEndTime THEN _
  2594.             GOTO 63658
  2595.       GOTO 63654
  2596. 63658 Found = ZTrue
  2597. 63659 ZErrCode = 0
  2598.       IF ZTempMaxBank > 255 THEN _                                   ' RM030801
  2599.          ZTempMaxBank = 255                                          ' RM030801
  2600.       IF ZDropCarSecChng > 255 THEN _                                ' RM030801
  2601.          ZDropCarSecChng = 255                                       ' RM030801
  2602.       EXIT SUB                                                       ' RM01159402
  2603. 63665 CALL OpenWork (2,ZPswdFile$)                                   ' RM01159402
  2604.       IF ZErrCode > 0 THEN _                                         ' RM01159402
  2605.          CALL UpdtCalr ("Err"+STR$(ZErrCode)+" opening " + ZPswdFile$,2) : _ ' RM01159402
  2606.          GOTO 63659                                                  ' RM01159402
  2607.       RETURN                                                         ' RM01159402
  2608.       END SUB
  2609. 63675 SUB SetUserUpDn STATIC
  2610.       ZDnlds = CVI(ZUserDnlds$)
  2611.       ZUplds = CVI(ZUserUplds$)
  2612.       ZDropTimes = ASC(ZDropTimes$)                                  ' DROP174
  2613.       ZBankTime = ASC(ZBankTime$)
  2614.       IF ZEnforceRatios THEN _
  2615.          ZDLToday! = CVS(ZTodayDl$) : _
  2616.          ZBytesToday! = CVS(ZTodayBytes$) : _
  2617.          ZDLBytes! = CVS(ZDlBytes$) : _
  2618.          ZULBytes! = CVS(ZULBytes$)
  2619.       END SUB
  2620.       SUB SetGlobalUpDn STATIC
  2621.       IF NOT ZGlobalsSet THEN _
  2622.          ZGlobalsSet = ZTrue : _
  2623.          ZGlobalDnlds = ZDnlds : _
  2624.          ZGlobalUplds = ZUplds : _
  2625.          ZGlobalDLToday! = ZDLToday! : _
  2626.          ZGlobalBytesToday! = ZBytesToday! : _
  2627.          ZGlobalDLBytes! = ZDLBytes! : _
  2628.          ZGlobalULBytes! = ZULBytes! : _
  2629.          ZGlobalDropTimes = ZDropTimes : _                           ' DROP174
  2630.          ZGlobalBankTime = ZBankTime
  2631.       END SUB
  2632. 63700 ' $SUBTITLE: 'TestANSI - test caller for ANSI support'
  2633. ' $PAGE
  2634. '
  2635. '  NAME    -- TestANSI
  2636. '                                  MEANING
  2637. '  INPUTS  -- ZTestANSITime   # of seconds to wait for ANSI response
  2638. '                             0 = do not test for ANSI
  2639. '
  2640. '  OUTPUTS -- ZANSITest       = True if ANSI Detected                ' CHAT174/RM030101
  2641. '
  2642. '  PURPOSE -- Test callers' software for support of ANSI graphics
  2643. '
  2644.       SUB TestANSI                                                   ' RM11159302
  2645.       IF ZTestANSITime < 1 THEN _
  2646.          GOTO 63705
  2647.       IF ZLocalUser THEN _
  2648.          IF ZDOSAnsi THEN _
  2649.             GOTO 63710 _
  2650.          ELSE GOTO 63705
  2651.       CALL SkipLine (1)                                              ' RM10049301
  2652.       CALL QuickTPut1 ("Testing GRAPHICS.... Please Wait...")        ' DGS051401-TH/RM10029302
  2653.       CALL SkipLine (1)                                              ' RM10049301
  2654.       CALL FlushCom(Temp$)
  2655.       CALL PutCom (ZEscape$ + "[6n")
  2656.       CALL DelayTime(ZTestANSITime)
  2657.       CALL WipeLine (5)
  2658.       CALL FlushCom(Temp$)
  2659.       CALL WipeLine (5)
  2660.       Temp = INSTR(Temp$,ZEscape$ + "[")
  2661.       IF Temp > 0 THEN _
  2662.          Temp = INSTR(Temp,Temp$,"R") : _
  2663.          IF TEMP > 0 AND TEMP < 9 THEN _
  2664.             GOTO 63710
  2665. 63705 ZHiLiteOff = ZTrue
  2666.       CALL SetGraphic (0)
  2667.       EXIT SUB
  2668. 63710 CALL FlushCom (Temp$)                                          ' DD061401
  2669.       CALL PutCom (ZEscape$ + "[!" + CHR$(8))                        ' DD061401/CM012394
  2670.       CALL DelayTime (ZTestANSITime)                                 ' DD061401
  2671.       CALL WipeLine (5)                                              ' DD061401
  2672.       CALL FlushCom (Temp$)                                          ' DD061401
  2673.       CALL WipeLine (5)                                              ' DD061401
  2674.       Temp = INSTR(Temp$,"RIPSCRIP")                                 ' DD061401
  2675.       IF Temp THEN                                                   ' DD061401
  2676.          CALL QuickTPut1 ("RIP detected!")                           ' DD061401
  2677.          ZRIPTest = ZTrue                                            ' RM07139301
  2678.       ELSE                                                           ' DD061401
  2679.          CALL QuickTPut1 ("ANSI detected!")                          ' DD061401
  2680.       END IF                                                         ' DD061401
  2681.       CALL SetGraphic(2)                                             ' RM07159301
  2682.       ZHiLiteOff = ZFalse
  2683.       ZANSITest = ZTrue                                              ' CHAT174/RM030101
  2684.       END SUB
  2685. 63715 ' Counts the number of words NumFound in ParseThis, defined
  2686.       ' as strings separated by those in ExcludeThis$
  2687.       '
  2688.       SUB ExcludeCount (ExcludeThis$, ParseThis$, NumFound) STATIC
  2689.       NumFound = 0
  2690.       StartAt = 1
  2691.       FOR I = 1 TO LEN(ParseThis$)
  2692.          IF INSTR(ExcludeThis$, MID$(ParseThis$, I, 1)) > 0 THEN _
  2693.             ParseLen = I - StartAt : _
  2694.             IF ParseLen > 0 THEN _
  2695.                NumFound = NumFound + 1
  2696.       NEXT
  2697.       END SUB
  2698. 63720 SUB AraAllCaps (Ara$(1),WhichElement)                          ' RM03309401
  2699.       Temp$ = Ara$(WhichElement)
  2700.       CALL AllCaps (Temp$)
  2701.       Ara$(WhichElement) = Temp$
  2702.       END SUB
  2703. '
  2704. 63750 ' $SUBTITLE: 'GetFastFile - Sets the Fast File Tabs List'
  2705. ' $PAGE
  2706. '
  2707. '  NAME    -- GetFastFile
  2708. '                                    MEANING
  2709. '  INPUTS  -- ZFastFileList$      The FIDX file
  2710. '             ZFastFileLocator$   The LIDX file
  2711. '
  2712. '  OUTPUTS -- ZFastTabs$        The Fast File Tabs string
  2713. '             ZFastFileSearch   Set true if fast file system in use
  2714. '
  2715. '  PURPOSE -- Sees if the tabs file for the fast file is present, and
  2716. '             loads it's contants if found.  Originally in RBBS-PC.BAS
  2717. '
  2718.       SUB GetFastFile
  2719.       CALL FindFile (ZFastFileList$,ZOK)
  2720.       IF ZOK THEN _
  2721.          CALL FindFile (ZFastFileLocator$,ZOK) : _
  2722.          IF ZOK THEN _
  2723.             ZFastFileSearch = ZTrue : _
  2724.             CALL BreakFileName (ZFastFileList$,Drive$,WasX$,ZWasY$,ZTrue) : _
  2725.             ZFileName$ = Drive$ + WasX$ + "T" + ZWasY$ : _
  2726.             CALL FindFile (ZFileName$,ZOK) : _
  2727.             ZErrCode = 0 : _
  2728.             IF ZOK THEN _
  2729.                FilNum = FREEFILE : _
  2730.                CALL OpenRand2 (ZFileName$,160,FilNum) : _            ' TAB174/RM04029401
  2731.                FIELD FilNum, 160 AS IndexRec$ : _                    ' TAB174/RM070693
  2732.                GET FilNum, 1 : _
  2733.                ZFastTabs$ = IndexRec$ : _
  2734.                CLOSE FilNum _
  2735.             ELSE ZFastTabs$ = ""
  2736.       END SUB
  2737. '
  2738. 63800 ' $SUBTITLE: 'SelectCD - Select Which CD to display'
  2739. ' $PAGE
  2740. '
  2741. '  NAME    -- SelectCD
  2742. '                                  MEANING
  2743. '  INPUTS  -- WhichDisk         1 - select CD Disk default
  2744. '                               2 - select CD Disk (user)
  2745. '                               3 - reset system defaults
  2746. '
  2747. '  OUTPUTS --
  2748. '
  2749. '
  2750. '
  2751. '
  2752. '
  2753. '
  2754. '
  2755. '  PURPOSE -- Select from a list of CD-ROM disks and set up system for
  2756. '             display of list and download of files.
  2757. '
  2758. '  WRITTEN BY: Richie Molinelli - 03/26/94
  2759. '
  2760.       SUB SelectCD (WhichDisk)
  2761.       ON WhichDisk GOTO 63801,63801,63830
  2762. 63801 CDCnfgFile$ = ZNodeWorkDrvPath$ + "CDR" + ZNodeID$ + ".CFG"
  2763.       CALL FindFile (CDCnfgFile$,Found)
  2764.       IF NOT Found THEN _
  2765.          EXIT SUB
  2766.       ZAbort = ZFalse
  2767.       FilNum = FREEFILE
  2768.       CALL OpenWork (FilNum,CDCnfgFile$)
  2769.       X = 0
  2770.       Temp = UBOUND(ZOutTxt$)
  2771.       DO WHILE NOT EOF(FilNum)
  2772.          X = X + 1
  2773.          LINE INPUT #FilNum,ZOutTxt$
  2774.          IF Temp < X THEN
  2775.             IF FRE(ZOutTxt$(1)) > 4096 THEN
  2776.                REDIM PRESERVE ZOutTxt$(X)
  2777.             ELSE
  2778.                CALL Lprnt ("Too many disks for available memory!",1)
  2779.                CALL UpdtCalr ("Too many CD-Disks listed for avail. memory",1)
  2780.                EXIT DO
  2781.             END IF
  2782.          END IF
  2783.          ZOutTxt$(X) = ZOutTxt$
  2784.       LOOP
  2785.       CLOSE FilNum
  2786.       IF WhichDisk = 1 THEN _
  2787.          Y = 1 : _
  2788.          GOTO 63820
  2789. 63810 CALL SkipLine (1)
  2790.       FOR Y = 1 to X
  2791.          CALL QuickTPut1 (ZFG7$ + STR$(Y) + SPACE$(4 - LEN(STR$(Y))) + ZFG3$ + _
  2792.           MID$(MID$(ZOutTxt$(Y),1,INSTR(ZOutTxt$(Y),",") - 1),1,ZRightMargin - 4) + ZEmphasizeOff$)
  2793.          CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
  2794.       NEXT
  2795.       CALL SkipLine (1)
  2796.       ZOutTxt$ = "List which CD-ROM [ENTER] = Quit"
  2797.       ZTurboKey = -ZTurboKeyUser
  2798.       ZStackC = ZFalse
  2799.       CALL PopCmdStack
  2800.       IF ZSubParm = -1 THEN _
  2801.          GOTO 63827
  2802.       IF ZWasQ = 0 THEN _
  2803.          ZAbort = ZTrue : _
  2804.          GOTO 63827
  2805.       IF VAL(ZUserIn$(ZAnsIndex)) < 1 OR VAL(ZUserIn$(ZAnsIndex)) > X THEN _
  2806.          CALL QuickTPut1 (ZEmphasizeOn$ + "Ivalid choice.  Must be 1 - " + LTRIM$(STR$(X)) + ZEmphasizeOff$) : _
  2807.          GOTO 63810
  2808.       Y = VAL(ZUserIn$(ZAnsIndex))
  2809. 63820 CALL AllCaps (ZOutTxt$(Y))
  2810.       X = INSTR(ZOutTxt$(Y),",")
  2811.       Z = INSTR(X + 1,ZOutTxt$(Y),",")
  2812.       Temp$ = MID$(ZOutTxt$(Y),X + 1,Z - (X+ 1))
  2813.       CALL BreakFileName (Temp$,DR$,Pre$,Ext$,ZTrue)
  2814.       ZLibDir$ = Temp$
  2815.       ZLibDirPath$ = DR$
  2816.       ZCurDirPath$ = DR$
  2817.       X = INSTR(Z + 1,ZOutTxt$(Y),",")
  2818.       Temp$ = MID$(ZOutTxt$(Y),Z + 1,X - (Z + 1))
  2819.       ZDirPrefix$ = MID$(Temp$,1,INSTR(Temp$,".") - 1)
  2820.       ZLibDirExtension$ = MID$(Temp$,INSTR(Temp$,".") + 1)
  2821.       Z = INSTR(X + 1,ZOutTxt$(Y),",")
  2822.       ZDirCatFile$ = DR$ + MID$(ZOutTxt$(Y),X + 1,Z - (X + 1))
  2823.       X = INSTR(Z + 1,ZOutTxt$(Y),",")
  2824.       ZFastFileList$ = DR$ + MID$(ZOutTxt$(Y),Z + 1,X - (Z + 1))
  2825.       Z = INSTR(X + 1,ZOutTxt$(Y),",")
  2826.       ZFastFileLocator$ = DR$ + MID$(ZOutTxt$(Y),X + 1,Z - (X + 1))
  2827.       ZLibDrive$ = MID$(ZOutTxt$(Y),Z + 1,1)
  2828.       X = INSTR(Z + 1,ZOutTxt$(Y),",")
  2829.       ZUseCDWorkDrive = (UCASE$(MID$(ZOutTxt$(Y),X + 1)) <> "N")
  2830.       Z = INSTR(X + 1,ZOutTxt$(Y),",")
  2831.       ZCDMultiChanger = (UCASE$(MID$(ZOutTxt$(Y),Z + 1,1)) = "Y")
  2832.       IF ZCDMultiChanger THEN _
  2833.          ZLibDrive$ = ""
  2834.       CALL GetFastFile
  2835. 63827 REDIM ZOutTxt$(Temp)
  2836.       EXIT SUB
  2837. 63830 ZLibDir$ = ZLibDirSave$
  2838.       ZLibDirPath$ = ZLibDirPathSave$
  2839.       ZDirPrefix$ = ZDirPrefixSave$
  2840.       ZCurDirPath$ = ZCurDirPathSave$
  2841.       ZLibDirExtension$ = ZLibDirExtensionSave$
  2842.       ZDirCatFile$ = ZDirCatFileSave$
  2843.       ZLibDrive$ = ZLibDriveSave$
  2844.       ZUseCDWorkDrive = ZFalse
  2845.       ZCDMultiChanger = ZFalse
  2846.       IF ZFastFileList$ <> ZFastFileListSave$ THEN
  2847.          ZFastFileList$ = ZFastFileListSave$
  2848.          ZFastFileLocator$ = ZFastFileLocatorSave$
  2849.          CALL GetFastFile
  2850.       END IF
  2851.       END SUB
  2852.