home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MAPL0206.ZIP / MBS40206.MRG < prev    next >
Encoding:
Text File  |  1993-02-06  |  87.5 KB  |  2,138 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against E:\RBBS\STOCK\RBBSSUB4.BAS to produce E:\RBBS\CHAT\RBBSSUB4.BAS
  3. * E:\RBBS\STOCK\RBBSSUB4.BAS:  Date 6-20-1992  Size 120885 bytes
  4. * ------------[ Created 02-06-1993 06:07:42 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB4.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  8. '  Copyright 1992 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB4.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986 - 1992
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  AnyBut         59760  Determine where a "word" begins
  23. '  AskUsers       64003  Ask users questions based on a script and save answers
  24. '  AskMore        59858  Check whether screen full
  25. '  AutoPage       60300  Check whether to notify sysop caller is on
  26. ' BadFileChar     59800  Check file name for bad character
  27. '  Bracket        59960  Puts strings around a substring
  28. '  BufFile        58400  Write a file to the user quickly
  29. '  BufString      58300  Write a string with imbedded CR/LF to the user quickly
  30. '  CheckColor     59930  Highlighting based on search string
  31. '  CmndToggle     64635  Processes user command to T)oggle preferences
  32. * ------[ first line different ]------
  33. '  CmndSysopXfer  64640  Sysop function to change Xfer count
  34. '  ColorDir       59920  Adds colorization to FMS directory entry
  35. '  ColorPrompt    59940  Colorizes prompts
  36. '  CompDate       59880+ Produces a computational data from YY, MM, DD
  37. '  ConfMail       59850  Check conference mail waiting
  38. '  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
  39. '  PackDate       59201  Compress date in string format to 2 characters
  40. '  EofComm        60000  Determine whether any chars in comm port buffer
  41. '  ExpireDate     59890  Calculate registration expiration date
  42. '  FakeXRpt       62650  Write out file transfer report for protocols that don't
  43. '  FindEnd        58770  Find where a "word" ends
  44. '  FindFile       58790  Determine whether a file exists without opening it
  45. '  FindLast       58600  Find last occurence of a string
  46. '  FMS            58200  Search the upload management system for entries
  47. '  GetAll         59780  Get list of all directories to display
  48. '  GetDirs        58895  Prompts for directories for file list/new/search cmds
  49. '  GetMsgAttr     62530  Restore attributes of original message
  50. '  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
  51. '  GlobalSrchRepl 60100  Global search and replace
  52. '  LogPDown       59400  Records download in private directory
  53. '  MarkTime       60200  Give visual feedback during lengthy process
  54. '  MetaGSR        60130  Meta statement global search and replace
  55. '  MsgImport      59698  Allow local user to import a text file to a message
  56. '  Muzak          59100  Play musical themes for different RBBS functions
  57. '  NewPassword    60668  Get a new password
  58. '  Protocol       62600  Determine if external protocols are available
  59. '  PutMsgAttr     62520  Save attributes of original message
  60. '  Remove         58210  Remove characters from within strings
  61. '  RotorsDir      58700  Searches for a file using list of subdirs
  62. '  RptTime        62540  Report date/time and time on
  63. '  SearchArray    58190  Check for the occurance of a string in an array
  64. '  SetEcho        59600  Set RBBS properly for who is to echo
  65. '  SetHiLite      59934  Set user preference on highlighting
  66. '  SetGraphic     59980  Sets graphic preference for text file display
  67. '  SetNewUserDef  64645  Sets new user defaults
  68. '  SmartText      58250  Process SMART TEXT control strings
  69. '  SubMenu        59500  Processes options that have sub-menus
  70. '  TimedOut       63000  Write timed exit semaphore file
  71. '  TimeLock       60180  Check for TIME LOCK on certain features
  72. '  Transfer       62624  RBBS-PC support for external protocols for file transfer
  73. '  Toggle         57000  Toggles or views user options
  74. ' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
  75. '  UnPackDate     59902  Uncompresses a 2 byte date
  76. '  UserColor      59965  Lets user set color for text and whether bold
  77. '  UserFace       59450  Processes programmable user interface
  78. '  ViewArc        64600  Display .ARC file contents to user
  79. '  PrivDoorRtn    62629  Private door exit routine
  80. '  WipeLine       58800  Wipes away a line so next prints in its place
  81. '  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
  82. '
  83. '  $INCLUDE: 'RBBS-VAR.BAS'
  84. '
  85. * REPLACING old line(s) by new
  86. 57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences'
  87. ' $PAGE
  88. '
  89. '  NAME    -- Toggle
  90. '
  91. '  INPUTS  -- ToggleOption      Option to toggle or view
  92. '                               according to the following:
  93. '    ToggleOption         PREFERENCE
  94. '   Toggle   VIEW
  95. * ------[ first line different ]------
  96. '     1       -1           AnsiEd Toggle
  97. '     2       -2           Bulletin review on logon
  98. '     3       -3           Case change
  99. '     4       -4           File review on logon
  100. '     5       -5           Highlight
  101. '     6       -6           Line feeds
  102. '     7       -7           Nulls
  103. '     8       -8           TurboKey
  104. '     9       -9           Expert
  105. '    10      -10           Bell
  106. '    11      -11           Chat Availability            'RChat401
  107. '
  108. '  OUTPUTS -- ZSubParm   passed from TPut
  109. '
  110. '  PURPOSE -- Sets or views any single user preference value
  111. '
  112.       SUB Toggle (ToggleOption) STATIC
  113.       ZSubParm = 0
  114.       IF ToggleOption < 0 THEN _
  115.          GOTO 57005
  116.       ON ToggleOption GOSUB _
  117.          57010, _         'AnsiEd toggle
  118.          57120, _         'Bulletin review on logon
  119.          57260, _         'Case change
  120.          57150, _         'File review on logon
  121.          57040, _         'Highlight
  122.          57100, _         'Line feeds
  123.          57210, _         'Nulls
  124.          57230, _         'TurboKey
  125.          57190, _         'Expert
  126.          57170, _            'Bell
  127.          57300             'Internode chat availability           ' RCHAT-Mpl
  128.       EXIT SUB
  129. * REPLACING old line(s) by new
  130. 57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
  131.       ON -ToggleOption GOSUB _
  132. * ------[ first line different ]------
  133.          57030, _         'AnsiEd Toggle
  134.          57130, _         'Bulletin review on logon
  135.          57270, _         'Case change
  136.          57160, _         'File review on logon
  137.          57050, _         'Highlight
  138.          57110, _         'Line feeds
  139.          57220, _         'Nulls
  140.          57240, _         'TurboKey
  141.          57200, _         'Expert
  142.          57180, _            'Bell
  143.          57310         'Internode chat availability               ' RCHAT-Mpl
  144.       EXIT SUB
  145. * REPLACING old line(s) by new
  146. 57010 ZFullScreenEditor = NOT ZFullScreenEditor      
  147. * DELETING old line(s)
  148. 57020
  149. * REPLACING old line(s) by new
  150. * ------[ first line different ]------
  151. 57030 X = 121
  152.       Gosub 57400
  153.       CALL QuickTPut1 (OutTxt$ + FNOffOn$(ZFullScreenEditor))
  154.       RETURN
  155. * REPLACING old line(s) by new
  156. 57040 IF ZEmphasizeOnDef$ = "" THEN _
  157. * ------[ first line different ]------
  158.        X = 122 : _       'Pe 01/19/93
  159.        Gosub 57400 : _   'Pe 01/19/93
  160.         CALL QuickTPut1 (OutTxt$) : _
  161.         RETURN
  162.      IF NOT ZHiLiteOff THEN _
  163.         CALL QuickTPut (ZColorReset$,0)
  164.      CALL SetHiLite (NOT ZHiLiteOff)
  165.      GOSUB 57050
  166.      CALL UserColor
  167.      RETURN
  168. * REPLACING old line(s) by new
  169. 57050 IF ZEmphasizeOn$ <> "" THEN _
  170.         ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  171.         ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  172. * ------[ first line different ]------
  173.        X = 123        'Pe 01/19/93
  174.        Gosub 57400    'Pe 01/19/93
  175.      CALL QuickTPut1 (ZEmphasizeOn$ + OutTxt$ + ZEmphasizeOff$ + _
  176.                        FNOffOn$(NOT ZHiLiteOff))
  177.      RETURN
  178. * REPLACING old line(s) by new
  179. * ------[ first line different ]------
  180. 57110  X = 124        'Pe 01/19/93
  181.        Gosub 57400    'Pe 01/19/93
  182.       CALL QuickTPut1 (OutTxt$ + FNOffOn$(ZLineFeeds))
  183.       CALL SetCrLf
  184.       RETURN
  185. * REPLACING old line(s) by new
  186. * ------[ first line different ]------
  187. 57130  X = 125       'Pe 01/19/93
  188.        Gosub 57400    'Pe 01/19/93
  189.       ZOutTxt$ = MID$("Skip Check",1 -5 * ZCheckBulletLogon,5) + OutTxt$
  190.       CALL QuickTPut1 (ZOutTxt$)
  191.       RETURN
  192. * REPLACING old line(s) by new
  193. * ------[ first line different ]------
  194. 57160  X = 126       'Pe 01/19/93
  195.        Gosub 57400   'Pe 01/19/93
  196.        ZOutTxt$ = MID$("CheckSkip",1 -5 * ZSkipFilesLogon,5) + OutTxt$
  197.        CALL QuickTPut1 (ZOutTxt$)
  198.       RETURN
  199. * REPLACING old line(s) by new
  200. * ------[ first line different ]------
  201. 57180  X = 127        'Pe 01/19/93
  202.        Gosub 57400   'Pe 01/19/93
  203.       ZOutTxt$ = OutTxt$  + FNOffOn$(ZPromptBell)
  204.       CALL QuickTPut1 (ZOutTxt$)
  205.       RETURN
  206. * REPLACING old line(s) by new
  207. * ------[ first line different ]------
  208. 57200   X = 128        'Pe 01/19/93
  209.        Gosub 57400    'Pe 01/19/93
  210.       ZOutTxt$ = MID$(OutTxt$,1 -6 * ZExpertUser,6)
  211.       CALL QuickTPut1 (ZOutTxt$)
  212.       RETURN
  213. * REPLACING old line(s) by new
  214. * ------[ first line different ]------
  215. 57220 X = 129       'Pe 01/19/93
  216.       Gosub 57400    'Pe 01/19/93
  217.       ZOutTxt$ = OutTxt$ + FNOffOn$(ZNulls)
  218.       CALL QuickTPut1 (ZOutTxt$)
  219.       RETURN
  220. * REPLACING old line(s) by new
  221. * ------[ first line different ]------
  222. 57240 X = 130 : _       'Pe 01/19/93
  223.       Gosub 57400 : _   'Pe 01/19/93
  224.       CALL QuickTPut1 (OutTxt$ + FNOffOn$(ZTurboKeyUser))
  225.       RETURN
  226. * REPLACING old line(s) by new
  227. 57260 IF NOT ZUpperCase THEN _
  228.          IF (NOT ZHiLiteOff) OR ZUserGraphicDefault$ = "C" THEN _
  229. * ------[ first line different ]------
  230.        X = 131 : _       'Pe 01/19/93
  231.        Gosub 57400 : _   'Pe 01/19/93
  232.             CALL QuickTPut1 (OutTxt$) : _
  233.             RETURN
  234.       ZUpperCase = NOT ZUpperCase
  235. * REPLACING old line(s) by new
  236. * ------[ first line different ]------
  237. 57270  X = 132        'Pe 01/19/93
  238.       Gosub 57400   'Pe 01/19/93
  239.       ZOutTxt$ = OutTxt$ + " " + _
  240.             MID$("and lowerONLY",1 - 9 * ZUpperCase,9)
  241.       CALL QuickTPut1 (ZOutTxt$)
  242. * REPLACING old line(s) by new
  243. 57280 ZUseTPut = (ZUpperCase OR ZXOnXOff)
  244.       RETURN
  245. * ------[ first line different ]------
  246. * INSERTING new line(s)
  247. 57300 ZAvailableForChat = NOT ZAvailableForChat                      ' RCHAT
  248. 57310  X = 133        'Pe 01/19/93
  249.        Gosub 57400   'Pe 01/19/93
  250.       ZOutTxt$ = OutTxt$ + MID$("NO YES", 1 -3 * ZAvailableForChat, 3)
  251.       CALL QuickTPut1 (ZOutTxt$)                                     ' RCHAT
  252.       RETURN
  253. 57400 Call GetRBBSString(X,RBBSString$)     'Pe 01/16/93
  254.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  255.       Return
  256.       END SUB
  257. '
  258. * REPLACING old line(s) by new
  259. 58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
  260. ' $PAGE
  261. '
  262. '  NAME    -- FMS
  263. '
  264. '  INPUTS  -- PARAMETER                      MEANING
  265. '             DirToSearch$          RBBS-PC "DIR" CATEGORY TO LOOK
  266. '                                     FOR
  267. '             SearchString$          STRING TO SEARCH FOR
  268. '             SearchDate$            DATE TO SEARCH FOR
  269. '             ZCategoryName$()
  270. '             ZCategoryCode$()
  271. '             ZCategoryDesc$()
  272. '             CatFound
  273. '             ZNumCategories
  274. '
  275. '  OUTPUTS -- ProcessedInFMS
  276. '             DnldFlag
  277. '
  278. '  PURPOSE -- To search the file management system and display the
  279. '             files being searched for as well as the catetory descriptions
  280. '
  281.       SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
  282.                ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
  283.                ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
  284.       DnldFlag = 0
  285.       CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
  286.       ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
  287. * ------[ first line different ]------
  288. IF ZFG4$ <> "" THEN _
  289.     FG5$ = ZEscape$ + "[1;34;40m" : _
  290.     FG6$ = ZEscape$ + "[1;37;41m" : _
  291.     FG7$ = ZEscape$ + "[1;37;44m"         'Pe 02/05/90
  292.       IF ProcessedInFMS THEN _
  293.          ZSubParm = 5 : _
  294.          GOSUB 58202 : _
  295.      CALL QuickTPut("",1) : _
  296.      CALL QuickTPut(FG5$+"╔═"+FG6$+" "+DirToSearch$+" "+FG5$+"═══",0) : _
  297.      CALL QuickTPut(FG6$ +" "+ ZCategoryDesc$(CatFound) +" " + FG5$ + "════" + _
  298.             ZFG3$+" " +  SrchDir$,1) : _
  299.      CALL QuickTPut(FG5$+ "║",1)  : _
  300.      CALL QuickTPut("╚═"+FG7$+"File Name"+FG5$+"═════" + FG7$ + "Size" + _
  301.             FG5$+"═════",0) : _
  302.      CALL QuickTPut(FG7$+"Date"+FG5$+"════"+FG7$ + "Description"+ _
  303.           FG5$+"════════════════════════════"+ZFG3$+" "+ZEmphasizeOff$,1) : _
  304.      Cat$ = ZCategoryCode$(CatFound) : _
  305.      CALL DispUpDir (CAT$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
  306.       EXIT SUB
  307. * REPLACING old line(s) by new
  308. 58202 ZOutTxt$ = SearchDate$
  309.       IF LEN(ZOutTxt$) > 0 THEN _
  310.          ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2)
  311. * ------[ first line different ]------
  312.       SrchDir$ = SearchString$ + _
  313.              ZOutTxt$
  314.       IF SrchDir$ <> "" THEN _
  315.           SrchDir$ = ZFG4$ + "Scanning for "  + ZFG2$ + SrchDir$
  316.       RETURN
  317.       END SUB
  318. * REPLACING old line(s) by new
  319. 58250 ' $SUBTITLE: 'SmartText - smart text substitution'
  320. ' $PAGE
  321. '
  322. '  NAME    -- SmartText   (WRITTEN BY DOUG AZZARITO)
  323. '
  324. '  INPUTS  -- StringWork$        string to scan for Smart Text
  325. '             CRFound            Does this line contain a CR?
  326. '             ZSmartTextCode     Smart Text control code
  327. '
  328. '  OUTPUTS -- StringWork$        Input string with Smart replaced
  329. '
  330. '  PURPOSE -- Smart Text allows control strings in text files
  331. '             to be replaced at runtime with user info or other
  332. '             data.  The Smart Text control code is a 1-byte
  333. '             code (configurable) with a 2-byte action code.
  334. '
  335. * ------[ first line different ]------
  336.       SUB SmartText (StringWork$, CRFound, OverStrike, Xtra) STATIC 'Pe040692
  337.       IF SmartCarry$<>"" THEN _
  338.          StringWork$ = SmartCarry$+StringWork$
  339.       Index = INSTR(StringWork$, ZSmartTextCode$)
  340.       WHILE Index > 0 AND Index < LEN(StringWork$)-1
  341.          IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _
  342.             SmartAct = 0 _
  343.          ELSE _
  344.             SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2))
  345.          IF SmartAct = 0 THEN _
  346.             WasI = 1 : _
  347.             GOTO 58254
  348.          SmartAct = (SmartAct+2)/3
  349.          ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _
  350.                            58266, 58267, 58268, 58269, 58270, _
  351.                            58271, 58272, 58273, 58274, 58275, _
  352.                            58276, 58277, 58278, 58279, 58280, _
  353.                            58281, 58282, 58283, 58284, 58285, _
  354.                            58286, 58287, 58289, 58290, 58291, _
  355.                            58292, 58293, 58294, 58295, 58296, _
  356.                            58297, 58298, 58299, 58300, 58301, _
  357.                            58302, 58303, 58304, 58305, 58306
  358.          GOSUB 58256
  359.          WasI = LEN(SmartHold$)
  360.          ReplaceLen = 3
  361.          IF OverStrike OR Overlay THEN _
  362.             IF WasI > 2 THEN _
  363.                ReplaceLen = WasI _
  364.             ELSE _
  365.                SmartHold$ = SmartHold$ + SPACE$(3 - WasI)
  366.          StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _
  367.                        MID$(StringWork$,Index+ReplaceLen)
  368. * REPLACING old line(s) by new
  369. * ------[ first line different ]------
  370. 58260 IF Xtra Then _           'Pe 02/05/93
  371.       SmartHold$ = "" : _      'Pe 02/05/93
  372.        Return                  'Pe 02/05/93
  373.       ZLinesPrinted = 0                     ' CS (Clear screen line count reset)
  374.       SmartHold$ = ""
  375.       RETURN
  376. * REPLACING old line(s) by new
  377. * ------[ first line different ]------
  378. 58262 if Xtra Then _          'Pe 02/05/93
  379.        SmartHold$ = "" : _    'Pe 02/05/93
  380.        Return                 ' Pe 02/06/93
  381.       ZNonStop = ZTrue                      ' NS Non-stop
  382.       SmartHold$ = ""
  383.       RETURN
  384. * REPLACING old line(s) by new
  385. 58273 SmartHold$ = ZCityState$              ' CT Users CITY & STATE
  386. * ------[ first line different ]------
  387.       CALL Trim (SmartHold$)                                         ' DD032301
  388.       RETURN
  389. * REPLACING old line(s) by new
  390. * ------[ first line different ]------
  391. 58295 SmartHold$ = ZConfName$ ' CN Conference Name
  392.       RETURN
  393. * INSERTING new line(s)
  394. 58296 SmartHold$ = ZFG5$                                          ' DD061303
  395.       GOTO 58258                                                  ' DD061303
  396. 58297 SmartHold$ = ZFG6$                                          ' DD061303
  397.       GOTO 58258                                                  ' DD061303
  398. 58298 SmartHold$ = ZFG7$                                          ' DD061303
  399.       GOTO 58258                                                  ' DD061303
  400. 58299 SmartHold$ = ZFG8$                                          ' DD061303
  401.       GOTO 58258                                                  ' DD061303
  402. * REPLACING old line(s) by new
  403. * ------[ first line different ]------
  404. 58300 SmartHold$ = ZFG9$                                          ' DD061303
  405.       GOTO 58258                                                  ' DD061303
  406. * REPLACING old line(s) by new
  407. * ------[ first line different ]------
  408. 58301 SmartHold$ = ZFGA$                                          ' DD061303
  409.       GOTO 58258                                                  ' DD061303
  410. * REPLACING old line(s) by new
  411. * ------[ first line different ]------
  412. 58302 SmartHold$ = ZFGB$                                          ' DD061303
  413.       GOTO 58258                                                  ' DD061303
  414. * REPLACING old line(s) by new
  415. * ------[ first line different ]------
  416. 58303 SmartHold$ = ZFGC$                                          ' DD061303
  417.       GOTO 58258                                                  ' DD061303
  418. * REPLACING old line(s) by new
  419. * ------[ first line different ]------
  420. 58304 SmartHold$ = ZFGD$                                          ' DD061303
  421.       GOTO 58258                                                  ' DD061303
  422. * REPLACING old line(s) by new
  423. * ------[ first line different ]------
  424. 58305 SmartHold$ = ZFGE$                                          ' DD061303
  425.       GOTO 58258                                                  ' DD061303
  426. * INSERTING new line(s)
  427. 58306 SmartHold$ = ZFGF$                                          ' DD061303
  428.       GOTO 58258                                                  ' DD061303
  429.       END SUB
  430. '
  431. 'Line numbers changed from 58300-58307 to 58350-58357 'Pe 06/21/92
  432. '  to allow additional SmartText Colors
  433. '
  434. * DELETING old line(s)
  435. 58307
  436. * INSERTING new line(s)
  437. 58350 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF'
  438. ' $PAGE
  439. '
  440. '  NAME    -- BufString
  441. '
  442. '  INPUTS  -- PARAMETER                      MEANING
  443. '             Strng$                  STRING TO BE WRITTEN OUT
  444. '             DataSize               LENGTH OF STRING - # LEFT
  445. '                                        CHARS TO OUTPUT
  446. '
  447. '  OUTPUTS -- Strng$                  IS WRITTEN TO THE USER
  448. '
  449. '  PURPOSE -- To search the string, Strng$, for embedded carriage
  450. '             returns and line feeds and write out each line with
  451. '             the appropriate substitution (cr/lf if to the local
  452. '             screen or cr/nulls/lf if to the communications port).
  453. '
  454.       SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC
  455.       WasL = LEN(Strng$)
  456.       IF PassedDataSize < WasL THEN _
  457.          WasL = PassedDataSize
  458.       IF WasL < 1 THEN _
  459.          EXIT SUB
  460.       ZFF = ZPageLength - 1
  461.       StartByte = 1
  462.       ZRet = ZFalse
  463.       IF CarryOver THEN _
  464.          IF ASC(Strng$) = 10 THEN _
  465.             StartByte = 2 : _
  466.             CALL SkipLine (1+ZJumpSearching)
  467.       CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$)
  468.       WasL = WasL + CarryOver
  469. 58351 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  470.       IF CRat > 0 AND CRat < WasL THEN _
  471.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  472.       ELSE CRFound = ZFalse
  473.       EOLlen = -2 * CRFound
  474.       IF CRFound THEN _
  475.          EOD = CRat _
  476.       ELSE EOD = WasL + 1
  477.       NumBytes = EOD - StartByte
  478.       StringWork$ = MID$(Strng$,StartByte,NumBytes)
  479.       IF NOT ZDeleteInvalid THEN _
  480.          GOTO 58352
  481.       Index = INSTR(StringWork$,"[")
  482.       WasJ = LEN(StringWork$) - 1
  483.       WHILE Index > 0 AND Index < WasJ
  484.          IF MID$(StringWork$,Index + 2,1) = "]" THEN _
  485.             IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _
  486.                MID$(StringWork$,Index + 1,1) = "*"
  487.          Index = INSTR(Index + 1,StringWork$,"[")
  488.       WEND
  489. 58352 IF ZJumpSearching THEN _
  490.          Temp$ = StringWork$ : _
  491.          CALL AllCaps (Temp$) : _
  492.          HiLitePos = INSTR (Temp$,ZJumpTo$) : _
  493.          IF HiLitePos = 0 THEN _
  494.             GOTO 58357 _
  495.          ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _
  496.               ZJumpSearching = ZFalse
  497.       IF ZSmartTextCode THEN _
  498.          CALL SmartText (StringWork$, CRFound, ZFalse,ZFalse)   'Pe 02/06/93
  499.       IF NOT ZLocalUser THEN _
  500.          CALL EofComm (Char) : _
  501.          IF Char <> -1 THEN _
  502.             GOTO 58353            ' comm port input
  503.       ZKeyboardStack$ = INKEY$ : _
  504.       IF ZKeyboardStack$ <> "" THEN _  ' keyboard input
  505.          GOTO 58353
  506.       CALL QuickTPut (StringWork$, - (CRFound))
  507.       GOTO 58354
  508. 58353 ZOutTxt$ = StringWork$
  509.       ZSubParm = 4
  510.       IF CRFound THEN ZSubParm = 5
  511.       CALL TPut
  512. 58354 IF ZRet THEN _
  513.          EXIT SUB
  514.       IF ZLinesPrinted < ZFF THEN _
  515.          GOTO 58357
  516. 58355 CALL CheckTimeRemain (MinsRemaining)
  517.       CALL CheckCarrier
  518.       IF ZSubParm = -1 THEN _
  519.          EXIT SUB
  520.       IF ZNonStop THEN _
  521.          GOTO 58357
  522.       IF NOT CRFound THEN _
  523.          GOTO 58357
  524.       ZForceKeyboard = ZTrue
  525.       CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts)
  526.       IF ZNo THEN _
  527.          ZRet = ZTrue : _
  528.          EXIT SUB
  529. 58357 StartByte = EOD + EOLlen
  530.       IF StartByte <= WasL THEN _
  531.          GOTO 58351
  532.       END SUB
  533. * REPLACING old line(s) by new
  534. 58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
  535. ' $PAGE
  536. '
  537. '  NAME    -- BufFile
  538. '
  539. '  INPUTS  -- PARAMETER                      MEANING
  540. '             FileSpec$               NAME OF THE FILE TO WRITE TO
  541. '                                                OUT TO THE USER
  542. '
  543. '  OUTPUTS -- NONE                    FILE IS WRITTEN TO THE USER
  544. '
  545. '  PURPOSE -- To display a sequential file to the user
  546. '
  547.       SUB BufFile (FilName$,AbortIndex) STATIC
  548.       CALL FindIt (FilName$)
  549.       IF NOT ZOK THEN _
  550.          GOTO 58419
  551.       ZNo = ZFalse
  552.       CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
  553.       IF ZErrCode > 0 THEN _
  554.          GOTO 58419
  555.       DataSize = ZBufferSize
  556.       FIELD 2, DataSize AS SeqRec$
  557.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  558.       ZJumpLast$ = ""
  559.       ZJumpSearching = ZFalse
  560.       ZJumpSupported = ZTrue
  561.       IF NOT ZStopInterrupts THEN _
  562.          IF NOT ZConcatFIles THEN _
  563.             IF NOT ZNonStop THEN _
  564. * ------[ first line different ]------
  565.             Call GetRBBSString(249,RBBSString$) : _     'Pe 01/16/93
  566.             ZOutTxt$ = RBBSString$  : _                'Pe 01/16/93
  567.                ZSubParm = 2 : _
  568.                CALL TPut
  569. IF ZSubParm = -1 THEN _
  570.      EXIT SUB               'Pe 02/09/90
  571.       WasTU = 0
  572. * REPLACING old line(s) by new
  573. 58419 CLOSE 2
  574. * ------[ first line different ]------
  575.       ZBypassTimeCheck = ZFalse
  576.       ZStopInterrupts = ZFalse
  577.       CALL QuickTPut (ZEmphasizeOff$,0)
  578.       ZJumpSupported = ZFalse
  579.       END SUB
  580. * REPLACING old line(s) by new
  581. 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file'
  582. ' $PAGE
  583. '
  584. '  NAME    -- RotorsDir
  585. '
  586. '  INPUTS  --     PARAMETER                    MEANING
  587. '             FilName$                  FILE NAME TO LOOK FOR
  588. '             SDIR.ARA                  ARRAY OF SUBDIRECTORIES
  589. '             MaxSearch                 MAX # OF SUBDIRECTORIES
  590. '             MarkingTime               WHETHER TO MARK TIME
  591. '
  592. '  OUTPUTS -- FNAME$                    ADD SUBDIRECTORY TO THE
  593. '                                       FILE NAME IF FOUND.  OTHER-
  594. '                                       WISE DON'T.
  595. '             ZOK                       TRUE IF FILE WAS Found
  596. '
  597. '  PURPOSE -- Hunt through a list of subdirectories to determine
  598. '             if a file is in any of them.  If file is found, open
  599. '             the file as file #2, add the drive/path to the file
  600. '             name, and sets ZOK to true.  If file isn't found, set
  601. '             file name to the last subdirectory searched -- which
  602. '             should be the upload subdirectory.
  603. '
  604. '             If the library menu is selected (ZMenuIndex = 6), then
  605. '             only 2 subdirectories are searched. The first being
  606. '             the work disk and the second being the selected
  607. '             library disk.
  608. '
  609. * ------[ first line different ]------
  610. '
  611. 'The following code replaces the ROTORSDIR sub in RBBSSUB4.BAS (Maple 0726).
  612. 'This code is fully compatible with the original ROTORSDIR code and makes RFM
  613. 'backwards compatible as well.  If extra FFS files are desired, create a file in
  614. 'the same directory called IDX.LST.  In this file, list the extra FIDX and LIDX
  615. 'files that you want to use.  They can have any name that you want.  If you want
  616. 'a Tab file, the name of the FIDX file must have only 7 characters to make room
  617. 'for the T added on to the name, just as is required with the primary FIDX file.
  618. 'Example:
  619. '
  620. 'c:\rbbs\dir\walnutf.def,c:\rbbs\dir\walnutl.def
  621. 'c:\rbbs\dir\pdsi7f.def,c:\rbbs\dir\pdsi7l.def
  622. 'c:\rbbs\dir\fidx1,c:\rbbs\dir\lidx1
  623. '
  624. 'These entries would cause RBBS to search the following in order:
  625. 'FIDX.DEF     FIDXT.DEF    LIDX.DEF
  626. 'WALNUTF.DEF  WALNUTFT.DEF WALNUTL.DEF
  627. 'PDSI7F.DEF   PDSI7FT.DEF  PDSI7L.DEF
  628. 'FIDX1        FIDX1T       LIDX1
  629.       SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC
  630.       CALL Carrier
  631.       IF ZSubParm = -1 THEN _   'Pe 01/04/89
  632.       EXIT SUB                              'Pe 01/04/89
  633.       ZOK = ZFalse
  634.       ZDotFlag = ZFalse
  635.       IF MarkingTime THEN _
  636.       Call GetRBBSString(91,RBBSString$) : _     'Pe 01/16/93
  637.       OutTxt$ = RBBSString$  : _                'Pe 01/16/93
  638.          CALL QuickTPut (OutTxt$ + " "+FilName$,0)
  639.       NumSearch = 1
  640.       WasX = 0
  641.   WasX$ = ZArkViewPath$ + FilName$  'Pe 08/15/91
  642.          CALL FindFile (WasX$,ZOK)  'Pe 08/15/91
  643.           IF ZOK THEN _             'Pe 08/15/91
  644.           GOTO 58710                'Pe 08/15/91
  645.       WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _
  646.          SDirAra$(NumSearch) <> ""
  647.          IF MarkingTime THEN _
  648.             CALL MarkTime (WasX)
  649.          WasX$ = SDirAra$(NumSearch) + _
  650.               FilName$
  651.          CALL FindFile (WasX$,ZOK)
  652.          NumSearch = NumSearch + 1
  653.       WEND
  654.       IF ZOK OR NOT ZFastFileSearch THEN _
  655.          GOTO 58710
  656. '* ------[ first line different ]------
  657.    TFastFileList$ = ZFastFileList$                            'SM102201
  658.    TFastFileLocator$ = ZFastFileLocator$                      'SM102201
  659.    TFastTabs$ = ZFastTab$                                     'SM102201
  660.    Tptr = 1                                                   'SM102201
  661.    CALL BreakFileName (ZFastFileList$, Drive$,TWasX$,ZWasY$,ZTrue)    'SM102201
  662.    TIdxLst$ = Drive$ + "IDX.LST"                              'SM102201
  663.    CALL FindIt (TIdxLst$)                                     'SM102201
  664.       IF NOT ZOK THEN _                                       'SM102201
  665.          TIdxLst$ = ""                                        'SM102201
  666. * DELETING old line(s)
  667. 58705
  668. * INSERTING new line(s)
  669. 58708 FSize = 21                                              'SM102201
  670.       CALL OpenRSeq (TFastFileList$,HighRec,WasX,21)         ' WM050501
  671.       FIELD #2, 12 AS SearchFile$, _                         ' WM050501
  672.                  4 AS SearchPath$, _                         ' WM050501
  673.                  3 AS SearchDate$, _                         ' WM050501
  674.                  2 AS SearchCrLf$                            ' WM050501
  675.       Get 2,1                                                 'SM102201
  676.       if SearchCrLf$ <> ZCrLf$ then _                         'SM102201
  677.          FSize = 18 : _                                       'SM102201
  678.          CALL OpenRSeq (TFastFileList$,HighRec,WasX,18) : _   'SM102201
  679.          FIELD #2, 12 AS SearchFile$, _                       'SM102201
  680.                     4 AS SearchPath$, _                       'SM102201
  681.                     2 AS SearchCrLf$                          'SM102201
  682.       IF ZErrCode <> 0 THEN _
  683.          ZOK = ZFalse : _                                     'SM102201
  684.          GOTO 58710
  685.       CALL TrimTrail (FilName$,".")
  686.       CALL BinSearch (FilName$,1,12,FSize,HighRec,RecFoundAt,RecFound$) 'SM102201
  687.       ZOK = (RecFoundAt > 0)
  688.       ZFastTab$ = TFastTab$                                   'SM102201
  689.       IF ZOK THEN _                                           'SM102201
  690.          GOTO 58709                                           'SM102201
  691.       IF TIdxLst$ = "" THEN _                                 'SM102201
  692.          GOTO 58710                                           'SM102201
  693.       CALL OpenWork(2,TIdxLst$)                               'SM102201
  694.       IF ZErrCode <> 0 THEN _                                 'SM102201
  695.          ZOK = ZFalse : _                                     'SM102201
  696.          GOTO 58710                                           'SM102201
  697.       CALL ReadParmsX(2,ZOutTxt$(),2,TPtr)                    'SM102201
  698.       IF ZErrCode <> 0 or ZOutTxt$(1)="" or ZOutTxt$(2)="" THEN _    'SM102201
  699.          ZOK = ZFalse : _                                     'SM102201
  700.          GOTO 58710                                           'SM102201
  701.       TPtr = TPtr + 1                                         'SM102201
  702.       TFastFileList$ = ZOutTxt$(1)                            'SM102201
  703.       TFastFileLocator$ = ZOutTxt$(2)                         'SM102201
  704.       CALL BreakFileName (TFastFileList$,Drive$,TWasX$,ZWasY$,ZTrue) 'SM102201
  705.       TFN$ = Drive$ + TWasX$ + "T" + ZWasY$                   'SM102201
  706.       CALL FindIt (TFN$)                                      'SM102201
  707.       IF ZOK THEN _                                           'SM102201
  708.          CALL OpenRSeq (TFN$, TWasX, WasY, 72) : _            'SM102201
  709.          FIELD 2, 72 AS IndexRec$ : _                         'SM102201
  710.          GET 2, 1 : _                                         'SM102201
  711.          ZFastTabs$ = IndexRec$ : _                           'SM102201
  712.          CLOSE 2 _                                            'SM102201
  713.       ELSE _                                                  'SM102201
  714.          ZFastTabs$ = ""                                      'SM102201
  715.       GOTO 58708                                              'SM102201
  716. 58709 ZOK = ZFalse                                            'SM102201
  717.       CALL CheckInt (MID$(RecFound$,13,4))
  718.       IF ZTestedIntValue < 1 THEN _
  719.          GOTO 58710
  720.       WasDX$ = DATE$                                         ' Pe081091
  721.       LSET SearchDate$ = CHR$ (VAL (MID$ (WasDX$, 9, 2)) - 48) + _   ' Pe081091
  722.                          CHR$ (VAL (MID$ (WasDX$, 1, 2)) + 31) + _   ' Pe081091
  723.                          CHR$ (VAL (MID$ (WasDX$, 4, 2)) + 31)       ' Pe081091
  724.       PUT 2, RecFoundAt                                      ' WM050501
  725.       CALL OpenRSeq (TFastFileLocator$,HighRec,WasX,66)       'SM102201
  726.       IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _
  727.          GOTO 58710
  728.       FIELD 2, 66 AS LocatorRec$
  729.       GET 2, ZTestedIntValue
  730.       Temp$ = WasX$
  731.       WasX$ = LEFT$(LocatorRec$,63)
  732.       CALL Trim (WasX$)
  733.       IF LEFT$(WasX$,2) = "M!" THEN _
  734.          ZOK = ZFalse : _
  735.          ZGSRAra$(1) = PassToMacro$ : _
  736.          WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _
  737.          CALL Trim (WasX$) : _
  738.          ZFileLocation$ = "" : _
  739.          CALL MacroExe (WasX$) : _
  740.          IF ZFileLocation$ = "" THEN _
  741.             ZOK = ZFalse : _
  742.             WasX$ = Temp$ : _
  743.             GOTO 58710 _
  744.          ELSE WasX$ = ZFileLocation$
  745.       WasX$ = WasX$ + FilName$
  746.       CALL FindFile (WasX$,ZOK)
  747.       IF NOT ZOK THEN _
  748.          WasX$ = SDirAra$(MaxSearch) + FilName$
  749.       GOTO 58710
  750. * REPLACING old line(s) by new
  751. * ------[ first line different ]------
  752. 58900 If ZEndList = ZTrue Then _     'Lk11/29/91
  753.       Exit Sub                       'Lk 11/29/91
  754.       ZOutTxt$ = ZDirPrompt$
  755.       ZMacroMin = 2
  756.       CALL PopCmdStack
  757.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  758.          EXIT SUB
  759.       CALL AraAllCaps (ZUserIn$(),ZAnsIndex)
  760.       IF ZUserIn$(ZAnsIndex) = "Q" THEN _
  761.          ZWasQ = 0 : _
  762.          EXIT SUB
  763.       ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
  764.       IF ZWasA = 0 THEN _
  765.          EXIT SUB
  766.       IF ZWasA > 8 THEN _
  767.          IF ZAnsIndex < ZLastIndex THEN _
  768.             GOTO 58900 _
  769.          ELSE GOTO 58902
  770.       IF ZWasA = 7 THEN _
  771.          ZExtendedOff = NOT ZExtendedOff _
  772.       ELSE ZExtendedOff = (ZWasA > 3)
  773.       Call GetRBBSString(116,RBBSString$)     'Pe 01/16/93
  774.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  775.       CALL QuickTPut1 (OutTxt$ + "  "+FNOffOn$(NOT ZExtendedOff))
  776.       GOTO 58900
  777. * DELETING old line(s)
  778. 59100
  779. 59102
  780. 59104
  781. 59106
  782. 59108
  783. 59110
  784. 59112
  785. 59114
  786. * REPLACING old line(s) by new
  787. 59456 ZFileName$ = ZCurPUI$
  788.       CALL Graphic (ZFileName$)
  789.       IF NOT ZOK THEN _
  790.          CALL UpdtCalr ("Missing menu " + ZCurPUI$,2) : _
  791.          ZCurPUI$ = ZPrevPUI$ : _
  792.          GOTO 59456
  793.       CALL BreakFileName(ZFileName$,ZWasZ$,ZActiveMenu$,ZWasZ$,ZTrue)
  794.       ZActiveMenu$ = LEFT$(ZActiveMenu$,1)
  795.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  796.       ZPrevPUI$ = ZCurPUI$
  797.       LINE INPUT #2,ZFileName$
  798. * ------[ first line different ]------
  799. '     LINE INPUT #2,Prompt$                'SM091926
  800.       INPUT #2,Prompt$                    'SM091926
  801.       INPUT #2,ValidChoice$,ActualCommands$
  802.       LINE INPUT #2,MenuChoice$
  803.       LINE INPUT #2,MenuName$
  804.       LINE INPUT #2,QuitCmd$
  805. '     LINE INPUT #2,QuitPrompt$                'SM091926
  806.       INPUT #2,QuitPrompt$                'SM091926
  807.       LINE INPUT #2,QuitSubCmds$
  808.       LINE INPUT #2,QuitMenuOpt$
  809.       LINE INPUT #2,QuitMenus$
  810.       CALL Graphic (ZFileName$)
  811.       CALL BreakFileName (ZFileName$,MenuDrvPath$,WasX$,ZWasY$,ZTrue)
  812.       MenuToDisplay$ = ZFileName$
  813.       WasJ = INSTR(ZOrigCommands$,"?")
  814.       IF WasJ < 1 THEN _
  815.          WasX$ = "" _
  816.       ELSE WasX$ = MID$(ZAllOpts$,WasJ,1)
  817. * REPLACING old line(s) by new
  818. 59458 IF ZExpertUser THEN _
  819. * ------[ first line different ]------
  820.    Call QuickTput (ZConfName$ + ": ",0) : _ 
  821.       CALL DispTimeRemain (TimeRemaining!) : _
  822.               GOTO 59461
  823. * REPLACING old line(s) by new
  824. 59460 ZNonStop = (ZPageLength < 1)
  825. * ------[ first line different ]------
  826.      ZDeleteInvalid = ZTrue   'Pe 01/08/90
  827.      CALL BufFile (MenuToDisplay$,WasX)
  828.      ZDeleteInvalid = ZFalse  'Pe 01/08/90
  829.      CALL Line25               'Pe 01/13/90
  830.      Call QuickTput (ZConfName$ + ": ",0)
  831.      CALL DispTimeRemain (TimeRemaining!) 'Pe time mod  Moved line number down 04/02/90
  832. * REPLACING old line(s) by new
  833. 59461 MID$(ZLastCommand$,2,1) = " "
  834.       ZOutTxt$ = Prompt$
  835.       ZTurboKey = -ZTurboKeyUser
  836.       CALL PopCmdStack
  837.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  838.          EXIT SUB
  839.       IF ZWasQ = 0 THEN _
  840. * ------[ first line different ]------
  841.          GOTO 59461
  842. * REPLACING old line(s) by new
  843. * ------[ first line different ]------
  844. 59492 CALL Putcom (CHR$(7))   'Pe 04/25/92
  845.       Call GetRBBSString(134,RBBSString$)     'Pe 01/16/93
  846.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  847.       CALL QuickTPut1 (OutTxt$ + ZWasZ$ + ">")
  848.       Call FlushKeys
  849.       GOTO 59460
  850.       END SUB
  851. * REPLACING old line(s) by new
  852. 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus'
  853. ' $PAGE
  854. '
  855. '  NAME    -- SubMenu
  856. '
  857. '  INPUTS  --   PARAMETER     MEANING
  858. '             PassedPrompt$   PROMPT TO DISPLAY
  859. '             CurMenu$        NOVICE MENU TO DISPLAY
  860. '             FrontOpt$       DRIVE/PATH/PREFIX OF FILE
  861. '                             NEEDED FOR TYPED OPTION
  862. '             BackOpt$        SUFFIX/EXTENSION OF FILE
  863. '                             NEEDED WITH TYPED OPTION
  864. '             ReturnOn$       LETTERS CALLING PROGRAM WANTS
  865. '                             CONTROL ON
  866. '             GRDefault$      GRAPHICS DEFAULT TO USE
  867. '             VerifyInMenu    WHETHER VERIFY OPTION IS IN MENU
  868. '             AllMenuOK       WHETHER CONTROL SHOULD RETURN
  869. '                             WHEN IN MENU
  870. '             ZAnsIndex       # OF COMMANDS IN TYPE AHEAD
  871. '             RequireInMenu   WHETHER OPTION MUST BE IN MENU
  872. '
  873. '  OUTPUTS -- ZWasZ$              OPTION PICKED
  874. '             ZFileName$      NAME OF FILE SUPPORTING OPTION
  875. '
  876. '
  877. '  PURPOSE -- Handles menus - including conference, bulletins,
  878. '             doors, questionnaires.  Supports sub-menus (i.e.
  879. '             an option on the menu that invokes another menu)
  880. '
  881. * ------[ first line different ]------
  882. '* ("Join what, L)ist M)ain N)ext, all/mail S)ince P)ers, or name ([Q]uit)"
  883. '        PassedPromt$
  884. '
  885. '*    WasA1$,       MsgDrvPath$     ,"M.DEF",       ",M,MAIN,N,S,P,Q,"
  886. '    CurMenu$    FrontOption$    BackOption$          ReturnOn$
  887. '
  888. ' *   ZTrue,        ZFalse,        ZFalse,      "C.DEF",    WasX,    ZFalse)
  889. ' PassedVerfiyin  AllMenuOk     ReQuiredinMenu  BackOption  InMenu  ChkGraphic
  890. '
  891.       SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _
  892.          BackOpt$,ReturnOn$,PassedVerifyInMenu, _
  893.          AllMenuOK,RequireInMenu,BackOpt2$,InMenu,ChkGraphic) STATIC
  894. * REPLACING old line(s) by new
  895. 59510 ZFileName$ = CurMenu$
  896.       InMenu = ZTrue
  897.       CALL BreakFileName (FrontOpt$,WasX$,FrontPre$,ZWasDF$,ZTrue)
  898.       CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
  899.       MenuFront$ = MenuDrv$ + LEFT$(WasX$,LEN(WasX$)-LEN(PreSuf$))
  900.       IF CurMenu$ = LastSubMenu$ THEN _
  901.          MenuFront$ = LEFT$(MenuFront$,LEN(MenuFront$)-1)
  902.       CALL Graphic (ZFileName$)
  903.       CurMenuVer$ = ZFileName$
  904.       ZStopInterrupts = ZFalse
  905. * ------[ first line different ]------
  906. * INSERTING new line(s)
  907. 59514 IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _               ' KG0111501
  908.          GOTO 59520
  909. * REPLACING old line(s) by new
  910. * ------[ first line different ]------
  911. 59520 CALL DispTimeRemain (MinsRemaining)                 'JA010801
  912.        ZOutTxt$ = PassedPrompt$            'get response
  913.       CALL PopCmdStack
  914.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  915.          EXIT SUB
  916. * REPLACING old line(s) by new
  917. 59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
  918.       CALL AllCaps (ZWasZ$)
  919. * ------[ first line different ]------
  920. '
  921.       IF CurMenu$ = ZConfMenu$ then                           ' Pe ConfNum Mod
  922. Call BreakFileName (ZConfMailList$,Drive$,Prefix$,Ext$,ZTrue)          
  923.      Call Findit(Drive$+"CONFNUM.DEF")                         ' Pe ConfNum2
  924.              IF NOT ZOK THEN _                                ' Pe ConfNum Mod
  925.                  Goto 59531                                   ' Pe ConfNum Mod
  926.       Call Openwork (2,Drive$ +"CONFNUM.DEF")                        ' Pe ConfNum Mod
  927.     While NOT EOF(2) AND (Not Foundit)                      ' Pe ConfNum Mod
  928.     Call ReadAny                                          ' Pe ConfNum Mod 
  929.          IF ZErrCode > 0 THEN _                               ' Pe Confnum2
  930.             Close 2 : _                                       'Pe Confnum2
  931.              Goto 59531                                       'Pe Confnum2
  932.         Dummy1$ = ZOutTxt$                                  ' Pe ConfNum Mod
  933.     Call ReadAny                                          ' Pe ConfNum Mod
  934.     Dummy2$ = ZOutTxt$                                    ' Pe ConfNum Mod
  935.     Call ReadAny                                          ' Pe ConfNum Mod
  936.     Dummy3$ = ZOutTxt$                                    ' Pe ConfNum Mod
  937.         Call ReadAny                'Pe 01/03/93
  938.         Dummy4$ = ZOutTxt$          'Pe 01/03/93
  939.     If ZWasZ$ = Dummy1$ or ZWasZ$ = Dummy4$ Then                           ' Pe ConfNum Mod
  940.           ZConfNum$ = Dummy1$
  941.          ConfNam$ = Dummy4$
  942.               Foundit = ZTrue                                 ' Pe ConfNum Mod
  943.        Call Breakfilename (Dummy2$,pre$,body$,ext$,ZFalse)    ' Pe ConfNum Mod
  944.              ZWasZ$ = Mid$(body$,1,LEN(body$)-(1))            ' Pe ConfNum Mod
  945.         END IF                                               ' Pe ConfNum Mod
  946.       Wend                                                    ' Pe ConfNum Mod
  947.     Close 2                                                   ' Pe ConfNum Mod
  948.   Foundit = ZFalse                                            ' Pe ConfNum Mod
  949.  End IF                                                       ' Pe ConfNum Mod
  950. '      
  951. * INSERTING new line(s)
  952. 59531    IF INSTR(ReturnOn$,","+ZWasZ$+",") THEN _  'check if calling pgm wants
  953.          EXIT SUB
  954.       IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
  955.          GOTO 59515
  956.       IF INSTR(ZWasZ$,".") > 0 THEN _
  957.          GOTO 59532
  958.       CALL BadFile (ZWasZ$,WasBF)
  959.       IF WasBF > 1 THEN _
  960.          GOTO 59532
  961.       FPre$ = MenuFront$   ' check for sub-option
  962.       PreSuf$ = "-"
  963.       CALL BadFile (FPRE$ + ZWasZ$ + "-",WasBF)
  964.       ZOK = ZFalse
  965.       IF WasBF < 2 THEN _
  966.          VerifyInMenu = ZFalse : _
  967.          GOSUB 59538
  968.       PreSuf$ = ""
  969.       VerifyInMenu = PassedVerifyInMenu
  970.       IF NOT ZOK THEN _
  971.          FPre$ = FrontOpt$ : _    ' check standard option
  972.          GOSUB 59538 : _
  973.          IF NOT ZOK THEN _    ' check option where menu is
  974.             FPre$ = MenuDrv$ + FrontPre$ : _
  975.             IF FrontOpt$ <> FPre$ THEN _
  976.                GOSUB 59538
  977.       IF NewMenu THEN _
  978.          NewMenu = ZFalse : _
  979.          GOTO 59515
  980.       IF ZOK THEN _
  981.          EXIT SUB
  982. * REPLACING old line(s) by new
  983. 59532 GOSUB 59547
  984. * ------[ first line different ]------
  985.       GOTO 59514                                                     ' KG011501
  986. * REPLACING old line(s) by new
  987. * ------[ first line different ]------
  988. 59547 Call GetRBBSString(134,RBBSString$)     'Pe 01/16/93
  989.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  990.       CALL QuickTPut1 (OutTxt$ + ZWasZ$+ ">")
  991.       ZLastIndex = 0
  992.       IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _
  993.          CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _
  994.                        CurMenu$ + " but not found",1)
  995.       RETURN
  996. * REPLACING old line(s) by new
  997. 59548 END SUB
  998. * ------[ first line different ]------
  999.  
  1000. * REPLACING old line(s) by new
  1001. 59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
  1002. ' $PAGE
  1003. '
  1004. '  NAME    -- MsgImport
  1005. '
  1006. '  INPUTS  --   PARAMETER     MEANING
  1007. '               MaxLines     MAXIMUM # OF LINES
  1008. '               MaxLen       MAXIMUM LENGTH OF A LINE
  1009. '               NumLines     NUMBER OF LINES ALREADY IN MESSAGE
  1010. '               LineAra$     ARRAY OF LINES IN MESSAGE
  1011. '
  1012. '  OUTPUTS --   NumLines
  1013. '               LineAra$
  1014. '
  1015. '  PURPOSE -- Allows local user to append a text file to
  1016. '             a message.   Will word wrap if needed.
  1017. '
  1018.       SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
  1019.       IF NOT (ZLocalUser OR ZSysop) THEN _
  1020. * ------[ first line different ]------
  1021.       Call GetRBBSString(135,RBBSString$) : _     'Pe 01/16/93
  1022.        OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1023.          CALL QuickTPut1 (OutTxt$) : _
  1024.          EXIT SUB
  1025. * REPLACING old line(s) by new
  1026. * ------[ first line different ]------
  1027. 59700 Call GetRBBSString(136,RBBSString$)     'Pe 01/16/93
  1028.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1029.       ZOutTxt$ = OutTxt$ + ZPressEnter$
  1030.       CALL PopCmdStack
  1031.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1032.          EXIT SUB
  1033.       CALL FindIt (ZUserIn$(ZAnsIndex))
  1034.       IF NOT ZOK THEN _
  1035.       Call GetRBBSString(70,RBBSString$) : _     'Pe 01/16/93
  1036.        OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1037.          CALL QuickTPut1 (ZUserIn$(ZAnsIndex) +OutTxt$) : _
  1038.          GOTO 59700
  1039.       WHILE NOT EOF(2) AND NumLines < MaxLines
  1040.          NumLines = NumLines + 1
  1041.          LINE INPUT #2,LineAra$(NumLines)
  1042.       WEND
  1043.       CLOSE 2
  1044.       CALL WordWrap (MaxLen,NumLines,LineAra$())
  1045.       END SUB
  1046. * REPLACING old line(s) by new
  1047. 59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message'
  1048. ' $PAGE
  1049. '
  1050. '  NAME    -- WordWrap
  1051. '
  1052. '  INPUTS  --   PARAMETER     MEANING
  1053. '               MaxLen       MAXIMUM LENGTH OF A SINGLE LINE
  1054. '               NumLines     NUMBER OF LINES IN A MESSAGE
  1055. '               LineAra$     ALL THE LINES IN THE MESSAGE
  1056. '
  1057. '  OUTPUTS --   NumLines
  1058. '               LineAra$
  1059. '
  1060. '  PURPOSE -- Batch adjusts a message, wrapping lines if
  1061. '             needed.  Preserves paragraph structure.
  1062. '
  1063.       SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC
  1064.       WasJ = 1
  1065. * ------[ first line different ]------
  1066.       SplitOn = 1  + .4 * MaxLen
  1067.       WHILE WasJ <= NumLines and NumLines < ZMaxMsgLines  'Pe 08/04/91
  1068.          ReFormatted = ZFalse
  1069. * REPLACING old line(s) by new
  1070. 59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
  1071. ' $PAGE
  1072. '
  1073. '  NAME    -- GetAll
  1074. '
  1075. '  INPUTS  --   PARAMETER     MEANING
  1076. '               LookIn$       NAME OF FILE TO SEARCH
  1077. '               DIR.EXT$      MAIN DIRECTORY EXTENSION TO USE
  1078. '               StartPos      Last POSITION USED IN ARRAY
  1079. '
  1080. '  OUTPUTS      StartPos     Last ELEMENT USED IN ARRAY
  1081. '               LoadInto$    ARRAY TO LOAD ELEMENTS Found
  1082. '
  1083. '  PURPOSE -- Creates a list (LoadInto$) of all directories
  1084. * ------[ first line different ]------
  1085. '             to be listed when A)ll is selected for a directory.
  1086. '             All uses config parm, which can be either a single
  1087. '             directory or list of directories (begin with "@").
  1088. '
  1089.       SUB GetAll (LoadInto$(1), StartPos) STATIC
  1090.       IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
  1091.          StartPos = StartPos + 1 : _
  1092.          LoadInto$(StartPos) = ZMasterDirName$ : _
  1093.          EXIT SUB
  1094.       ZOK = ZFalse
  1095.       IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
  1096.          CALL FindIt(MID$(ZMasterDirName$,2))
  1097.       IF NOT ZOK THEN _
  1098.       Call GetRBBSString(137,RBBSString$) : _     'Pe 01/16/93
  1099.        OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1100.          CALL QuickTPut1 (OutTxt$) : _
  1101.          EXIT SUB
  1102.       MaxLoad = UBOUND(LoadInto$, 1)
  1103.       StartSort = StartPos + 1
  1104.       WHILE NOT EOF(2) AND StartPos < MaxLoad
  1105.          LINE INPUT #2, ZOutTxt$
  1106.          StartPos = StartPos + 1
  1107.          LoadInto$(StartPos) = ZOutTxt$
  1108.       WEND
  1109.       CLOSE 2
  1110.       END SUB
  1111. * REPLACING old line(s) by new
  1112. 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
  1113. ' $PAGE
  1114. '
  1115. '  NAME    -- ConfMail
  1116. '
  1117. '  INPUTS  -- PARAMETER        MEANING
  1118. '         SKIP.CONFIRM         Whether to skip confirm of option
  1119. '         ZConfMailList$       File of user/message pairs to check
  1120. '         ZActiveUserFile$     Active user file (restored on exit)
  1121. '         ZActiveMessageFile$  Active msg file (restored)
  1122. '  OUTPUTS -- None
  1123. '
  1124. '  PURPOSE -- Quicking scans message header record to get
  1125. '             last msg # and user record to get whether any
  1126. '             new mail and last msg read, reports both, using
  1127. '             highlighting if new mail to caller.
  1128. '
  1129.       SUB ConfMail (MailCheckConfirm,LinkNew,LinkPers) STATIC
  1130.       SkipJoinUnjoin = ZNonStop OR LinkNew OR LinkPers
  1131.       IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
  1132.          CALL FindIt (ZConfMailList$) _
  1133.       ELSE ZOK = ZFalse
  1134.       IF NOT ZOK THEN _
  1135.          EXIT SUB
  1136.       IF PrevMailList$ <> ZConfMailList$ THEN _
  1137.          SkipParms = 0
  1138.       PrevMailList$ = ZConfMailList$
  1139.       IF MailCheckConfirm THEN _
  1140. * ------[ first line different ]------
  1141.       Call GetRBBSString(301,RBBSString$) : _     'Pe 01/16/93
  1142.       ZOutTxt$ = RBBSString$  : _                'Pe 01/16/93
  1143.          ZTurboKey = -ZTurboKeyUser : _
  1144.          CALL PopCmdStack : _
  1145.          IF ZNo OR ZSubParm < 0 THEN _
  1146.             EXIT SUB
  1147.       CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
  1148.       CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
  1149.       CALL SkipLine (1)
  1150.       Call GetRBBSString(138,RBBSString$)     'Pe 01/16/93
  1151.        OutTxt$ = RBBSString$                'Pe 01/16/93
  1152.       CALL QuickTPut1 (OutTxt$)
  1153.       IF LinkNew OR LinkPers THEN _
  1154.          ZLinkedConf$ = ""
  1155.       AnyMail = ZFalse
  1156.       ZStopInterrupts = ZFalse
  1157.       WasA1$ = ZActiveUserFile$
  1158.       MsgFileSave$ = ZActiveMessageFile$
  1159.       TempIndivValue$ = ""
  1160.       UserFileIndexSave = ZUserFileIndex
  1161.       UserRecordHold$ = ZUserRecord$
  1162.       ZOK = ZTrue
  1163.       CALL ReadParms (ZWorkAra$(),1,SkipParms)
  1164.       IF SkipParms = 0 THEN _
  1165.          LogicalEOF$ = "" _
  1166.       ELSE LogicalEOF$ = ZWorkAra$(1)
  1167. * REPLACING old line(s) by new
  1168. 59851 IF NOT ZOK THEN _
  1169.          GOTO 59856 _
  1170.       ELSE IF EOF(2) THEN _
  1171.               IF LogicalEOF$ = "" OR SkipParms = 0 THEN _
  1172.                  GOTO 59856 _
  1173.               ELSE CALL FindIt (ZConfMailList$) : _
  1174.                    SkipParms = 0 : _
  1175.                    GOTO 59851
  1176. * ------[ first line different ]------
  1177. '                    Call ReadAny                               'Pe ConfNum Mod
  1178. '                    ConfNum$ = ZOutTxt$                        'Pe ConfNum Mod
  1179.                CALL ReadAny
  1180.          IF ZErrCode > 0 THEN _             'Pe 02/04/93
  1181.             GOTO 59856                      'Pe 02/04/93
  1182.          ZActiveUserFile$ = ZOutTxt$
  1183.          CALL ReadAny
  1184.          IF ZErrCode > 0 THEN _
  1185.             GOTO 59856
  1186.          SkipParms = SkipParms + 2
  1187.          ZActiveMessageFile$ = ZOutTxt$
  1188.  '      Call ReadAny                             'Pe 01/03/93
  1189.  '      ConfNam$ = ZOutTxt$                      'Pe 01/03/93
  1190.          CALL FindFile (ZActiveUserFile$,ZOK)
  1191.          IF NOT ZOK THEN _
  1192.             GOTO 59856
  1193.          CALL OpenUser (ZHighestUserRecord)
  1194.          FIELD 5, 128 AS ZUserRecord$
  1195.          CALL FindFile (ZActiveMessageFile$,ZOK)
  1196.          IF NOT ZOK THEN _
  1197.             GOTO 59856
  1198.          CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
  1199.                         0,0,ZHighestUserRecord,_
  1200.                         Found,HoldUserFileIndex,ZWasSL)
  1201.          IF NOT Found THEN _
  1202.             GOTO 59853
  1203.          CALL OpenMsg
  1204.          FIELD 1, 128 AS ZMsgRec$
  1205.          GET 1,1
  1206.          AnyMail = ZTrue
  1207.          WasX = CVI(MID$(ZUserRecord$,57,2))
  1208.          FileWait = (WasX AND 4096) > 0
  1209.          WasX = (WasX AND 512) > 0
  1210.          CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
  1211.          InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
  1212. * REPLACING old line(s) by new
  1213. 59852    IF InCur THEN _
  1214.             FileWait = ZFileWaiting : _
  1215.             WasX = ZMailWaiting : _
  1216.             ZWasA = ZLastMsgRead _
  1217.          ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
  1218.          ZWasB = VAL(LEFT$(ZMsgRec$,8))
  1219.          WasZ = (ZWasB - ZWasA)
  1220.          IF WasZ < 0 THEN _
  1221.             ZWasA = 0 : _
  1222.             WasZ = ZWasB _
  1223.          ELSE IF WasZ = 0 THEN _
  1224.                  WasX = ZFalse
  1225.          ZWasSL = LEN(CurPre$)
  1226.          IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
  1227.             Conf$ = "MAIN" _
  1228.          ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
  1229.          ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
  1230.          Temp = LEN(ZOutTxt$)
  1231.          ZOutTxt$ = SPACE$(-(Temp<4) * (4-Temp)) + ZOutTxt$
  1232.          IF (WasZ > 0 AND LinkNew) OR (WasX AND LinkPers) THEN _
  1233.             IF (NOT InCur) THEN _
  1234.                CALL AddLink (Conf$)
  1235. * ------[ first line different ]------
  1236.             Temp = (INSTR(ZCarriageReturn$ + ZLinkedConf$,ZCarriageReturn$ + Conf$ + ZCarriageReturn$) > 0)
  1237. '         ZWasY$ = Space$(3-LEN(ZConfNum$)) + ZConfNum$ + " "  ' Pe ConfNum2 Mod
  1238.          ZWasY$ = MID$(" *",1-Temp,1) + Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))  ' Pe ConfNum Mod
  1239.          IF WasX THEN _
  1240.             WasX$ = ZEmphasizeOn$ + "Some to you" + ZEmphasizeOff$ _
  1241.          ELSE WasX$ = "          "
  1242.          IF FileWait THEN _
  1243.             Temp$ = "  - " + ZEmphasizeOn$ + "Personal Uplds" + ZEmphasizeOff$ _
  1244.          ELSE Temp$ = ""
  1245.          ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s) " + _
  1246.               WasX$ + Temp$
  1247.          ZSubParm = 5
  1248.          CALL TPut
  1249.          ZJumpSupported = ZFalse
  1250.          IF SkipJoinUnjoin THEN _
  1251.             CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
  1252.             GOTO 59853
  1253.          ZTurboKey = -ZTurboKeyUser
  1254.          CALL AskMore (",J)oin,U)njoin,L)ink,D)elink",ZTrue,ZFalse,WasX,ZFalse)
  1255.          IF ZNo THEN _
  1256.             GOTO 59856
  1257.          WasX$ = LEFT$(ZUserIn$(1),1)
  1258.          CALL AllCaps (WasX$)
  1259.          IF WasX$ = "J" THEN _
  1260.             ZLastIndex = ZWasQ : _
  1261.             ZHomeConf$ = Conf$ : _
  1262.             GOTO 59856
  1263.          IF WasX$ = "D" THEN _
  1264.             CALL DeLink (Conf$) : _
  1265.             GOTO 59852
  1266.          IF WasX$ = "L" THEN _
  1267.             CALL AddLink (Conf$) : _
  1268.             GOTO 59852
  1269.          IF WasX$ = "U" THEN _
  1270.             IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
  1271.       Call GetRBBSString(139,RBBSString$) : _     'Pe 01/16/93
  1272.        OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1273.           CALL QuickTPut1 (OutTxt$) _
  1274.             ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
  1275.                  ZUserFileIndex = HoldUserFileIndex : _
  1276.                  ZSubParm = 6 : _
  1277.                  CALL FileLock : _
  1278.                  PUT 5, HoldUserFileIndex : _
  1279.                  ZSubParm = 8 : _
  1280.                  CALL FileLock : _
  1281.                 Call GetRBBSString(140,RBBSString$) : _     'Pe 01/16/93
  1282.                 OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1283.                  CALL QuickTPut1 (OutTxt$ + " " + Conf$)
  1284. * REPLACING old line(s) by new
  1285. 59856 ZActiveUserFile$ = WasA1$
  1286.       CALL OpenUser (ZHighestUserRecord)
  1287.       FIELD 5, 128 AS ZUserRecord$
  1288.       IF (NOT ZRet) AND NOT AnyMail THEN _
  1289. * ------[ first line different ]------
  1290.       Call GetRBBSString(141,RBBSString$) : _     'Pe 01/16/93
  1291.        OutTxt$ = RBBSString$ : _                'Pe 01/16/93
  1292.          CALL QuickTPut1 (OutTxt$)
  1293.       ZUserFileIndex = UserFileIndexSave
  1294.       LSET ZUserRecord$ = UserRecordHold$
  1295.       ZActiveMessageFile$ = MsgFileSave$
  1296.       CALL OpenMsg
  1297.       FIELD 1, 128 AS ZMsgRec$
  1298.       GET 1,1
  1299.       ZNonStop = (ZPageLength < 1)
  1300.       WasX$ = ZUserIn$(ZAnsIndex+1)
  1301.       CALL AllCaps (WasX$)
  1302.       ZAnsIndex = ZAnsIndex - (WasX$ = "C")
  1303.       SkipParms = -(NOT EOF(2))*SkipParms
  1304.       LinkNew = ZFalse
  1305.       LinkPers = ZFalse
  1306.       END SUB
  1307. * REPLACING old line(s) by new
  1308. 59860 CALL QuickTPut (ZEmphasizeOff$,0)
  1309.       IF CantInterrupt THEN _
  1310.          ZTurboKey = 2 : _
  1311.          ZForceKeyboard = ZTrue : _
  1312. * ------[ first line different ]------
  1313.       Call GetRBBSString(302,RBBSString$) : _     'Pe 01/16/93
  1314.       ZOutTxt$ = RBBSString$  _                'Pe 01/16/93
  1315.       ELSE GOSUB 59870 : _
  1316.            ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
  1317.       WasX = LEN(ZOutTxt$) + 2
  1318.       ZNoAdvance = OverWrite
  1319.       ZSubParm = 1
  1320.       IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
  1321.          ZTurboKey = -ZTurboKeyUser
  1322.       ZMacroMin = 2
  1323.       CALL TGet
  1324.       IF ZSubParm = -1 THEN _
  1325.         EXIT SUB
  1326.       ZTurboKey = ZFalse
  1327.       ZWasDF$ = ZUserIn$ (1)
  1328.       CALL AllCaps (ZWasDF$)
  1329.       WasI = INSTR(";C;A;",";"+ZWasDF$+";")
  1330.       IF WasI = 1 THEN _
  1331.          ZNonStop = ZTrue : _
  1332.          ZWasQ = 0
  1333.       CALL WipeLine (WasX + LEN(ZUserIn$))
  1334.       IF NOT ZHiLiteOff THEN _
  1335.          CALL QuickTPut (ZLastSmartColor$,0) : _  'Pe 08/26/92
  1336.          CALL QuickTput (ZEmphaSizeOFF$,0)      'Lk 07/16/90
  1337.       IF CantInterrupt THEN _
  1338.          ZNo = ZFalse : _
  1339.          EXIT SUB
  1340.       IF WasI = 3 THEN _
  1341.          ZLastIndex = 0 : _
  1342.          AbortIndex = 32000
  1343.       IF ZNo THEN _
  1344.          ZKeyboardStack$ = "" : _
  1345.          ZCommPortStack$ = "" : _
  1346.          ZLastSmartColor$ = ""
  1347.       IF NOT ZJumpSupported THEN _
  1348.          EXIT SUB
  1349.       IF ZWasDF$ = "J" THEN _
  1350.          IF ZWasQ > 1 THEN _
  1351.             ZUserIn$ = ZUserIn$(2) : _
  1352.             GOTO 59866 _
  1353.          ELSE Call GetRBBSString(303,RBBSString$) : _     'Pe 01/16/93
  1354.          ZOutTxt$ = RBBSString$ + ZPressEnterExpert$ : _
  1355.               CALL PopCmdStack : _
  1356.               IF ZWasQ = 0 THEN _
  1357.                  EXIT SUB _
  1358.               ELSE GOTO 59866
  1359.       IF ZWasDF$ <> "R" THEN _
  1360.          EXIT SUB
  1361.       ZUserIn$ = ZJumpLast$
  1362. * REPLACING old line(s) by new
  1363. 59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _
  1364. * ------[ first line different ]------
  1365.                ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen) + _
  1366.                ZEmphasizeoff$         'Pe 03/15/92
  1367.       EXIT SUB
  1368. * REPLACING old line(s) by new
  1369. 59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference'
  1370. ' $PAGE
  1371. '
  1372. '  NAME    --  SetHiLite
  1373. '
  1374. '  INPUTS  --  PARAMETER                   MEANING
  1375. '              SetTo              New value (True or False)
  1376. '              ZEmphasizeOnDef$   String turns emphasize on
  1377. '              ZEmphasizeOffDef$  String turns emphasize off
  1378. '
  1379. '  OUTPUTS --  ZHiLiteOff       Callers preference on Hilite
  1380. '              ZEmphasizeOn$       String to use for emphasis
  1381. '              ZEmphasizeOff$      String to use after emphasis
  1382. '
  1383.       SUB SetHiLite (SetTo) STATIC
  1384.       ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo)
  1385.       IF ZHiLiteOff THEN _
  1386.          ZEmphasizeOn$ = "" : _
  1387.          ZEmphasizeOff$ = "" : _
  1388.          ZFG1$ = "" : _
  1389.          ZFG2$ = "" : _
  1390.          ZFG3$ = "" : _
  1391. * ------[ first line different ]------
  1392.          ZFG4$ = "" : _                                              ' DD061303/COLR
  1393.          ZFG5$ = "" : _                                              ' DD061303/COLR
  1394.          ZFG6$ = "" : _                                              ' DD061303/COLR
  1395.          ZFG7$ = "" : _                                              ' DD061303/COLR
  1396.          ZFG8$ = "" : _                                              ' DD061303/COLR
  1397.          ZFG9$ = "" : _                                              ' DD061303/COLR
  1398.          ZFGA$ = "" : _                                              ' DD061303/COLR
  1399.          ZFGB$ = "" : _                                              ' DD061303/COLR
  1400.          ZFGC$ = "" : _                                              ' DD061303/COLR
  1401.          ZFGD$ = "" : _                                              ' DD061303/COLR
  1402.          ZFGE$ = "" : _                                              ' DD072201/COLR
  1403.          ZFGF$ = "" _                                                ' DD072201/COLR
  1404.       ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _
  1405.            ZFG1$ = ZFG1Def$ : _
  1406.            ZFG2$ = ZFG2Def$ : _
  1407.            ZFG3$ = ZFG3Def$ : _
  1408.            ZFG4$ = ZFG4Def$ : _                                      ' DD061303/COLR
  1409.            ZFG5$ = ZEscape$ + "[1;34;40m" : _     'Brt Blue          ' DD061303/COLR
  1410.            ZFG6$ = ZEscape$ + "[1;35;40m" : _     'Brt Magenta       ' DD061303/COLR
  1411.            ZFG7$ = ZEscape$ + "[1;33;44m" : _     'Yellow/Blue       ' DD061303/COLR
  1412.            ZFG8$ = ZEscape$ + "[1;33;42m" : _     'Yellow/Green      ' DD061303/COLR
  1413.            ZFG9$ = ZEscape$ + "[1;33;41m" : _     'Yellow/Red        ' DD061303/COLR
  1414.            ZFGA$ = ZEscape$ + "[1;33;45m" : _     'Yellow/Magenta    ' DD061303/COLR
  1415.            ZFGB$ = ZEscape$ + "[1;37;44m" : _     'White/Blue        ' DD061303/COLR
  1416.            ZFGC$ = ZEscape$ + "[1;37;42m" : _     'White/Green       ' DD061303/COLR
  1417.            ZFGD$ = ZEscape$ + "[1;37;41m" : _     'White/Red         ' DD061303/COLR
  1418.            ZFGE$ = ZEscape$ + "[1;37;45m" : _     'White/Magenta     ' DD061303/COLR
  1419.            ZFGF$ = ZEscape$ + "[1;36;44m"         'Brt Cyan/Blue     ' DD061303/COLR
  1420.       END SUB
  1421. * REPLACING old line(s) by new
  1422. 59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts'
  1423. ' $PAGE
  1424. '
  1425. '  NAME    --  ColorPrompt
  1426. '
  1427. '  INPUTS  --  PARAMETER                   MEANING
  1428. '              Strng$              String to colorize
  1429. '              ZHiLiteOff          Whether highlighting is off
  1430. '              ZEmphasizeOn$       String to use for emphasis
  1431. '              ZEmphasizeOff$      String to use after emphasis
  1432. '
  1433. '  OUTPUTS --  Strng$              Colorized string
  1434. '
  1435. '  PURPOSE -- colorizes a string based on sysop settings
  1436. '             and the string.
  1437. '                        [...] is the default - put in emphasis
  1438. '                        <...> options to type - put in ZFG4$
  1439. '                        and first two preceeding words use ZFG1$ and ZFG2$
  1440. '                        options identified on right by ) and on
  1441. '                        left by space or comma - put in ZFG4$
  1442. '
  1443.       SUB ColorPrompt (Strng$) STATIC
  1444. * ------[ first line different ]------
  1445.       CALL SmartText(Strng$,ZTrue,ZFalse,ZFalse)        'Pe 02/06/93
  1446.       IF ZHiLiteOff THEN _
  1447.          EXIT SUB
  1448.       AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0)
  1449.       WasX = INSTR(Strng$,"<")
  1450.       IF WasX > 0 THEN _
  1451.          GOTO 59943
  1452.       WasX = INSTR(Strng$,"[")   ' highlight default
  1453.       IF WasX > 0 THEN _
  1454.          WasY = INSTR(WasX,Strng$,"]") : _
  1455.          IF WasY > 0 THEN _
  1456.             CALL FindLast (LEFT$(Strng$,WasY),"[",WasX,Temp) : _
  1457.             CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$)
  1458.       IF AlreadyColorized THEN _
  1459.          EXIT SUB
  1460.       WasX = INSTR(Strng$,"<")
  1461.       IF WasX < 1 THEN _
  1462.          GOTO 59945
  1463. * REPLACING old line(s) by new
  1464. 59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text'
  1465. ' $PAGE
  1466. '
  1467. '  NAME    --  UserColor
  1468. '
  1469. '  INPUTS  --  PARAMETER                   MEANING
  1470. '              ZEmphasizeOff$            Normal text color
  1471. '
  1472. '  OUTPUTS --  ZEmphasizeOff$            New text color
  1473. '              ZBoldText$                Whether bold (0 not, 1 bold)
  1474. '              ZUserTextColor            ANSI Color selected
  1475. '
  1476. '  PURPOSE --  Lets caller select desired color and whether bold.
  1477. '
  1478.       SUB UserColor STATIC
  1479.       IF ZHiLiteOff THEN _
  1480. * ------[ first line different ]------
  1481.          EXIT SUB _                                                  ' DD061303/COLR
  1482.       ELSE _                                                         ' DD061303/COLR
  1483.          ZFG5$ = ZEscape$ + "[1;34;40m" : _     'Brt Blue          ' DD061303/COLR
  1484.          ZFG6$ = ZEscape$ + "[1;35;40m" : _     'Brt Magenta       ' DD061303/COLR
  1485.          ZFG7$ = ZEscape$ + "[1;33;44m" : _     'Yellow/Blue       ' DD061303/COLR
  1486.          ZFG8$ = ZEscape$ + "[1;33;42m" : _     'Yellow/Green      ' DD061303/COLR
  1487.          ZFG9$ = ZEscape$ + "[1;33;41m" : _     'Yellow/Red        ' DD061303/COLR
  1488.          ZFGA$ = ZEscape$ + "[1;33;45m" : _     'Yellow/Magenta    ' DD061303/COLR
  1489.          ZFGB$ = ZEscape$ + "[1;37;44m" : _     'White/Blue        ' DD061303/COLR
  1490.          ZFGC$ = ZEscape$ + "[1;37;42m" : _     'White/Green       ' DD061303/COLR
  1491.          ZFGD$ = ZEscape$ + "[1;37;41m" : _     'White/Red         ' DD061303/COLR
  1492.          ZFGE$ = ZEscape$ + "[1;37;45m" : _     'White/Magenta     ' DD061303/COLR
  1493.          ZFGF$ = ZEscape$ + "[1;36;44m"         'Brt Cyan/Blue     ' DD061303/COLR
  1494. * REPLACING old line(s) by new
  1495. 59970 CALL QuickTPut (ZEmphasizeOff$,0)
  1496. * ------[ first line different ]------
  1497.        Call GetRBBSString(142,RBBSString$)      'Pe 01/16/93
  1498.        OutTxt$ = RBBSString$                 'Pe 01/16/93
  1499.       ZOutTxt$ = OutTxt$ + ZPressEnterExpert$
  1500.       GOSUB 59973
  1501.       IF ZWasQ = 0 THEN _
  1502.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  1503.              ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
  1504.          EXIT SUB
  1505.       CALL AllCaps (ZUserIn$)
  1506.       WasX = INSTR("RGYBPCW",ZUserIn$)
  1507.       IF WasX = 0 THEN _
  1508.          GOTO 59970
  1509.       ZUserTextColor = 30 + WasX
  1510.       ZOutTxt$ = "Make text Bright (Y,[N])"
  1511.       GOSUB 59973
  1512.       ZBoldText$ = CHR$(48 - ZYes)
  1513.       ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  1514.       GOTO 59970
  1515. * REPLACING old line(s) by new
  1516. * ------[ first line different ]------
  1517. 59973 ZSubParm = 1
  1518.       ZTurboKey = -ZTurboKeyUser
  1519.       CALL TGet
  1520.       IF ZSubParm = -1 THEN _
  1521.          EXIT SUB
  1522.       RETURN
  1523.       END SUB
  1524. * REPLACING old line(s) by new
  1525. 59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference'
  1526. ' $PAGE
  1527. '
  1528. '  NAME    --  SetGraphic
  1529. '
  1530. '  INPUTS  --  PARAMETER                   MEANING
  1531. '              GraphicsNumber        0=None, 1=Ascii, 2=color
  1532. '
  1533. '  OUTPUTS --  ZWasGR                Shared var - set to
  1534. '                                    graphics.number
  1535. '              ZUserGraphicDefault$ What add to file name to
  1536. '                                    see if got graphics file ver
  1537. '
  1538. '  PURPOSE --  Sets file graphics preference
  1539. '
  1540.       SUB SetGraphic (GraphicsNumber) STATIC
  1541.       ZWasGR = GraphicsNumber
  1542.       IF ZWasGR = 2 THEN _
  1543.          ZDR1$ = ZFG1Def$ : _
  1544.          ZDR2$ = ZFG2Def$ : _
  1545.          ZDR3$ = ZFG3Def$ : _
  1546. * ------[ first line different ]------
  1547.          ZDR4$ = ZFG4Def$ : _                                        ' DD061303/COLR
  1548.          ZDR5$ = ZFG5$ : _                                           ' DD061303/COLR
  1549.          ZDR6$ = ZFG6$ : _                                           ' DD061303/COLR
  1550.          ZDR7$ = ZFG7$ : _                                           ' DD061303/COLR
  1551.          ZDR8$ = ZFG8$ : _                                           ' DD061303/COLR
  1552.          ZDR9$ = ZFG9$ : _                                           ' DD061303/COLR
  1553.          ZDRA$ = ZFGA$ : _                                           ' DD061303/COLR
  1554.          ZDRB$ = ZFGB$ : _                                           ' DD061303/COLR
  1555.          ZDRC$ = ZFGC$ : _                                           ' DD061303/COLR
  1556.          ZDRD$ = ZFGD$ : _                                           ' DD061303/COLR
  1557.          ZDRE$ = ZFGE$ : _                                           ' DD061303/COLR
  1558.          ZDRF$ = ZFGF$ _                                             ' DD061303/COLR
  1559.       ELSE ZDR1$ = "" : _
  1560.            ZDR2$ = "" : _
  1561.            ZDR3$ = "" : _
  1562.            ZDR4$ = "" : _                                            ' DD061303/COLR
  1563.            ZDR5$ = "" : _                                            ' DD061303/COLR
  1564.            ZDR6$ = "" : _                                            ' DD061303/COLR
  1565.            ZDR7$ = "" : _                                            ' DD061303/COLR
  1566.            ZDR8$ = "" : _                                            ' DD061303/COLR
  1567.            ZDR9$ = "" : _                                            ' DD061303/COLR
  1568.            ZDRA$ = "" : _                                            ' DD061303/COLR
  1569.            ZDRB$ = "" : _                                            ' DD061303/COLR
  1570.            ZDRC$ = "" : _                                            ' DD061303/COLR
  1571.            ZDRD$ = "" : _                                            ' DD061303/COLR
  1572.            ZDRE$ = "" : _                                            ' DD061303/COLR
  1573.            ZDRF$ = ""                                                ' DD061303/COLR
  1574.       ZUserGraphicDefault$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0))
  1575.       END SUB
  1576. * REPLACING old line(s) by new
  1577. 60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace'
  1578. ' $PAGE
  1579. '
  1580. '  NAME    --  MetaGSR
  1581. '
  1582. '  INPUTS  --  PARAMETER               MEANING
  1583. '              Strng$              String to edit
  1584. '
  1585. '  OUTPUTS --  Strng$              Edited string
  1586. '
  1587. '  PURPOSE --  Global search and replace for meta variables
  1588. '
  1589. * ------[ first line different ]------
  1590. ' DSZ port [PORT#] speed [BAUD] estimate 0 [CBAUD] ha on sz -r [FILE]
  1591. '
  1592. ' RBBS will substitute the variable [CBAUD] with the actual modem speed.
  1593. '
  1594.       SUB MetaGSR (Strng$,OverStrike) STATIC
  1595.       WasY = 1
  1596. * REPLACING old line(s) by new
  1597. 60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1)
  1598. * ------[ first line different ]------
  1599.       WasI = INSTR("      BAUD  CBAUD PORT  PORT# PARITYPROTO NODE  FILE  ",MetaVal$) ' KG122301
  1600.       IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _
  1601.          WasY = WasX + 1 : _
  1602.          GOTO 60131
  1603.       WasJ = (WasI-1)\6 + 1
  1604.       WasK = (WasI+4)\6 + 1
  1605.       IF WasK > WasJ THEN _
  1606.          EXIT SUB
  1607.       ON WasJ GOTO 60155, _
  1608.                 60137, _
  1609.                 60138, _
  1610.                 60139, _
  1611.                 60141, _
  1612.                 60143, _
  1613.                 60145, _
  1614.                 60147, _
  1615.                 60149, _
  1616.                 60151
  1617. * REPLACING old line(s) by new
  1618. * ------[ first line different ]------
  1619. 60149 IF ZWasBatchTransfer THEN _              'Pe BatchUp Mod
  1620.  CALL BreakFileName (ZFileName$,Drive$,Prefix$,Ext$,ZFalse) : _
  1621.        WorkHold$ = Drive$+"\" _    'Pe 12/30/92
  1622.      ELSE _
  1623.        IF ZBatchTransfer THEN _ 
  1624.          WorkHold$ = "@" + ZNodeWorkFile$ _
  1625.       ELSE WorkHold$ = ZFileName$
  1626.       GOTO 60151
  1627. * REPLACING old line(s) by new
  1628. 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
  1629. ' $PAGE
  1630. '
  1631. '  NAME    --  TimeLock  (written by Doug Azzarito)
  1632. '
  1633. '  INPUTS  --  PARAMETER                   MEANING
  1634. '              ZTimeLockSet               SECONDS/SESSION TO LOCK
  1635. '
  1636. '  OUTPUTS --  ZSubParm     -1 if feature is LOCKED
  1637. '
  1638. '  PURPOSE -- Check elapsed time for lock duration
  1639. '
  1640.       SUB TimeLock STATIC
  1641.       CALL TimeRemain(MinsRemaining)
  1642.       IF ZSecsUsedSession! >= ZTimeLockSet THEN _
  1643.          ZOK = ZTrue : _
  1644.          EXIT SUB
  1645.       ZOutTxt$ = ZFirstName$
  1646.       CALL NameCaps(ZOutTxt$)
  1647.       CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _
  1648. * ------[ first line different ]------
  1649.                    STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _
  1650.                    " more minutes" + _
  1651.                    STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds")
  1652.       CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
  1653.       ZOK = ZFalse
  1654.       ZLastIndex = 0
  1655.       END SUB
  1656. * REPLACING old line(s) by new
  1657. 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
  1658. ' $PAGE
  1659. '
  1660. '  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
  1661. '                        'and RoseMarie Siddiqui
  1662. '
  1663. '  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
  1664. '                                       notification and how
  1665. '
  1666. '  OUTPUTS -- NONE
  1667. '
  1668. '  PURPOSE -- Search ZAutoPageDef$ for match on whether
  1669. '             on name, security level, whether new user.
  1670. '             Also controls whether caller notified and
  1671. '             number of times sysop has bell rung.
  1672. '             And what tune to play (if any).
  1673. '
  1674.       SUB AutoPage STATIC
  1675.       CALL FindIt (ZAutoPageDef$)
  1676.       IF NOT ZOK THEN _
  1677.          EXIT SUB
  1678.       ZErrCode = 0
  1679.       ZOK = ZFalse
  1680.       WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
  1681.          CALL ReadParms (ZWorkAra$(),4,1)
  1682.          IF ZErrCode = 0 THEN _
  1683.             ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
  1684.             IF NOT ZOK THEN _
  1685.                IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
  1686.                   ZOK = ZTrue _
  1687.                ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
  1688.                        ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
  1689.                        IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
  1690.                           IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
  1691.                              ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
  1692.                                 ZOK = ZTrue
  1693.       WEND
  1694.       CLOSE 2
  1695.       IF ZErrCode > 0 OR NOT ZOK THEN _
  1696.          ZErrCode = 0 : _
  1697.          EXIT SUB
  1698.       ZPageStatus$ = "AP!"
  1699.       IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
  1700.          ZOutTxt$ = "Telling sysop you're on..." : _
  1701.          CALL RingCaller
  1702.       ZWasB = (ZWorkAra$(4) = "")
  1703.       ZWorkAra$(5) = ""
  1704.      TempSnoop = ZSnoop
  1705.      ZSnoop = ZTrue
  1706.      CALL Line25
  1707.       FOR WasI = 1 TO VAL(ZWorkAra$(3))
  1708.          IF ZWasB THEN _
  1709.             CALL LPrnt (ZBellRinger$,0) : _
  1710.          ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
  1711.       NEXT
  1712. * ------[ first line different ]------
  1713.       ZSnoop = TempSnoop
  1714.       END SUB
  1715. * REPLACING old line(s) by new
  1716. 62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
  1717. ' $PAGE
  1718. '
  1719. '  NAME    --  RptTime
  1720. '
  1721. '  INPUTS  --  PARAMETER                   MEANING
  1722. '
  1723. '  OUTPUTS --
  1724. '
  1725. '  PURPOSE --  Tells user time used on system
  1726. '
  1727.       SUB RptTime STATIC
  1728.       CALL SkipLine (1)
  1729.       CALL GetTime
  1730.       CALL AMorPM
  1731.       Mins = (ZSessionHour * 60) + ZSessionMin
  1732.       CALL Carrier
  1733.       IF ZSubParm = -1 THEN _
  1734.          EXIT SUB
  1735.       CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$)
  1736.       CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _
  1737.                         STR$(ZSessionSec) + " secs")
  1738. * ------[ first line different ]------
  1739. '      CALL Talk (7,ZOutTxt$)
  1740.       END SUB
  1741. * REPLACING old line(s) by new
  1742. 62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
  1743.          ZTransferOption$ = MID$(ZTransferOption$,2)
  1744.       IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
  1745. * ------[ first line different ]------
  1746.        Call GetRBBSString(143,RBBSString$) : _      'Pe 01/16/93
  1747.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1748.          CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+OutTxt$) : _
  1749.          ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
  1750.       END SUB
  1751. * REPLACING old line(s) by new
  1752. 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
  1753. ' $PAGE
  1754. '
  1755. '  NAME    -- Transfer
  1756. '
  1757. '  INPUTS  --     PARAMETER                    MEANING
  1758. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  1759. '                                        = 2 UPLOAD FILE TO RBBS-PC
  1760. '              ZFileName$                NAME OF FILE FOR Transfer
  1761. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  1762. '                                        TO BE USED BY KERMIT (COM1
  1763. '                                        OR COM2)
  1764. '              ZBPS                      = -1 FOR   300 BAUD
  1765. '                                        = -2 FOR   450 BAUD
  1766. '                                        = -3 FOR  1200 BAUD
  1767. '                                        = -4 FOR  2400 BAUD
  1768. '                                        = -5 FOR  4800 BAUD
  1769. '                                        = -6 FOR  9600 BAUD
  1770. * ------[ first line different ]------
  1771. '                                        = -7 FOR 14400 BAUD
  1772. '                                        = -8 FOR 19200 BAUD
  1773. '
  1774. '  OUTPUTS  -- NONE
  1775. '
  1776. '  PURPOSE -- To transfer files using external protocols
  1777. '
  1778.       SUB Transfer STATIC
  1779. IF ZUpBatchTransfer Then _
  1780.    Exit Sub
  1781.       IF ZPrivateDoor THEN _
  1782.          CALL PrivDoorRtn : _
  1783.          EXIT SUB
  1784.       IF ZTransferFunction = 1 THEN _
  1785.          ZUserIn$ = ZDownTemplate$ : _
  1786.          ZWasZ$ = "send " _
  1787.       ELSE IF ZTransferFunction = 2 THEN _
  1788.               ZUserIn$ = ZUpTemplate$ : _
  1789.               ZWasZ$ = "receive "
  1790.       CALL MetaGSR (ZUserIn$,ZFalse)
  1791.       CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
  1792.       CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0)
  1793. '
  1794.       IF ZBatchTransfer or ZWasBatchTransfer THEN _        'Pe BatchUp mod
  1795.          CALL QuickTPut1 ("(BATCH)")  _
  1796.       ELSE CALL QuickTPut1 (ZFileNameHold$)
  1797. '
  1798.    IF ZWasBatchTransfer THEN _                             'Pe BatchUp mod
  1799.         Temp$ = ZBatchWorkFile$ _
  1800.           ELSE IF ZBatchTransfer Then _
  1801.         Temp$ = ZNodeWorkFile$  
  1802.    IF ZBatchTransfer or ZWasBatchTransfer THEN _        'Pe BatchUp mod
  1803.        CALL OpenWork (2,Temp$) : _
  1804.           WHILE NOT EOF(2) : _
  1805.             CALL ReadAny : _
  1806.            CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
  1807.          CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
  1808.      WEND
  1809. '
  1810.       IF ZAutoEnd = 1 THEN _                  'Pe 03/30/92
  1811.        Call GetRBBSString(69,RBBSString$) : _      'Pe 01/16/93
  1812.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1813.          CALL QuickTPut1 (OutTxt$)
  1814.       CALL PrivDoorRtn
  1815.       END SUB
  1816. * REPLACING old line(s) by new
  1817. 62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
  1818.       IF WasX$ = "" THEN _
  1819.          EXIT SUB
  1820.       CALL FindIt (WasX$)
  1821.       IF NOT ZOK THEN _
  1822.          ZOutTxt$ = "Missing door program" : _
  1823.          CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
  1824.          ZSnoop = ZTrue : _
  1825.          CALL LPrnt (ZOutTxt$,1) : _
  1826.          EXIT SUB
  1827.       ZOutTxt$(1) = "CLS"
  1828.       GOSUB 62633
  1829. * ------[ first line different ]------
  1830.       ZOutTxt$(2) = "ECHO " + ZOutTxt$
  1831.       ZOutTxt$(3) = ZDiskForDos$ + _
  1832.               "COMMAND /C " + _
  1833.               ZUserIn$
  1834.       ZOutTxt$(4) = ZRBBSBat$
  1835.       ZPrivateDoor = ZTrue
  1836.       Call GetRBBSString(144,RBBSString$)      'Pe 01/16/93
  1837.       OutTxt$ = RBBSString$                 'Pe 01/16/93
  1838.       CALL QuickTPut1 (OutTxt$)
  1839.       LOCATE 25,1
  1840.       CALL LPrnt(ZLineFeed$,0)
  1841.       CALL DoorInfo
  1842.       CALL RBBSExit (ZOutTxt$(),4)
  1843. * REPLACING old line(s) by new
  1844. 62629 GOSUB 62633
  1845. * ------[ first line different ]------
  1846.       'CLS
  1847.       CALL LPrnt (ZOutTxt$,1)
  1848.       CALL ShellExit (ZUserIn$)
  1849. * REPLACING old line(s) by new
  1850. 62630 IF ZPrivateDoor THEN _
  1851.          CALL RestoreCom : _
  1852.          CALL DelayTime (7 + ZBPS) : _
  1853.          CALL SetBaud : _
  1854. * ------[ first line different ]------
  1855.        Call GetRBBSString(145,RBBSString$) : _      'Pe 01/16/93
  1856.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1857.          CALL QuickTPut1 (OutTxt$)
  1858. * REPLACING old line(s) by new
  1859. * ------[ first line different ]------
  1860. 62633 IF ZTransferFunction = 1 THEN _                 'Pe 06/19/92
  1861.       ZOutTxt$ = STR$(ZUserSecLevel) + _
  1862.          " " + _
  1863.          ZActiveUserName$ + _
  1864.          " " +  _ 
  1865.                  ZWasCI$ + ZCrlF$ : _
  1866.       ZOutTxt$ = ZOutTxt$ +  "ECHO Downloading " +STR$(ZBytesInFile#) + _     'Pe 10/11/91
  1867.        " bytes" + _                                'Pe 10/11/91
  1868.       " At "+  STR$(ZBaudTest!) + " Baud" + _
  1869.        " Time:" + _
  1870.      STR$(INT(ZBlocksInFile# / 60)) + _
  1871.      " min," + _
  1872.      STR$(INT(ZBlocksInFile# - (INT(ZBlocksInFile# / 60) * 60))) + _
  1873.      " sec (approx)"_                              'Pe 10/11/91
  1874.      Else ZOutTxt$ = "Uploading file"+ _               'Pe 06/19/92
  1875.           " At "+  STR$(ZBaudTest!) + " Baud"          'Pe 06/19/92
  1876.          RETURN
  1877.       END SUB
  1878. * REPLACING old line(s) by new
  1879. 62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change'
  1880. ' $PAGE
  1881. '
  1882. '  NAME    --  SetExpert
  1883. '
  1884. '  INPUTS  --  PARAMETER                   MEANING
  1885. '              ZExpertUser          WHETHER IS AN EXPERT
  1886. '
  1887. '  OUTPUTS --  ZMorePrompt$         Pause prompt
  1888. '              ZPressEnter$         Prompt to press enter
  1889. '
  1890. '  PURPOSE --  Make more helpful prompt for novices and shorter
  1891. '              one for experts
  1892. '
  1893.       SUB SetExpert STATIC
  1894.       IF ZExpertUser THEN _
  1895. * ------[ first line different ]------
  1896.          ZMorePrompt$ = "More <[Y],N,A" : _
  1897.          ZPressEnter$ = ZPressEnterExpert$ : _
  1898.          EXIT SUB
  1899.       ZMorePrompt$ = "More [Y]es,N)o,A)bort"
  1900.       ZPressEnter$ = ZPressEnterNovice$
  1901.       END SUB
  1902. * REPLACING old line(s) by new
  1903. 62670 ZOutTxt$ = Prompt$
  1904. * ------[ first line different ]------
  1905.       ZHidden = ZTrue
  1906.       CALL PopCmdStack
  1907.       ZHidden = ZFalse
  1908.       IF ZSubParm < 0 OR ZWasQ = 0 THEN _
  1909.          EXIT SUB
  1910.       IF LEN(ZUserIn$) > 15 THEN _
  1911.        Call GetRBBSString(75,RBBSString$) : _      'Pe 01/16/93
  1912.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1913.          CALL QuickTPut1 ("15" + OutTxt$) : _
  1914.          GOTO 62670
  1915.       IF INSTR(ZUserIn$,";") > 0 THEN _
  1916.        Call GetRBBSString(146,RBBSString$) : _      'Pe 01/16/93
  1917.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1918.          CALL QuickTPut1 (OutTxt$) : _
  1919.          GOTO 62670
  1920.    IF NOT ZSYSOP Then                                     ' Pe 04/16/92
  1921.       IF INSTR(ZUserIn$," ") > 0 THEN _                'lk 022792
  1922.        Call GetRBBSString(147,RBBSString$) : _      'Pe 01/16/93
  1923.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1924.          CALL QuickTPut1 (OutTxt$) : _ 
  1925.          GOTO 62670                                    'lk 022792
  1926.     End If                                                 'Pe 04/16/92
  1927.       IF DisallowSpaces THEN _
  1928.          IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
  1929.        Call GetRBBSString(148,RBBSString$) : _      'Pe 01/16/93
  1930.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1931.             CALL QuickTPut1 (OutTxt$) : _
  1932.             GOTO 62670
  1933.       CALL AllCaps (ZUserIn$)
  1934.       ZWasZ$ = ZUserIn$
  1935.       END SUB
  1936. * REPLACING old line(s) by new
  1937. 64005 ZChatAvail = ZFalse
  1938.       QestChain = ZFalse
  1939.       LastQues = 0
  1940.       CALL Graphic (ZFileName$)
  1941.       IF NOT ZOK THEN _
  1942.          EXIT SUB
  1943.       CALL ReadParms (ZOutTxt$(),2,1)
  1944.       IF ZErrCode > 0 THEN _
  1945.          EXIT SUB
  1946.       PrevAppend$ = AppendFileName$
  1947.       AppendFileName$ = ZOutTxt$(1)
  1948.       MaxSecLevel = VAL(ZOutTxt$(2))
  1949.       WasX = INSTR(ZOutTxt$(2)," ")
  1950.       IF WasX > 0 THEN _
  1951.          IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
  1952. * ------[ first line different ]------
  1953.        Call GetRBBSString(149,RBBSString$) : _      'Pe 01/16/93
  1954.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  1955.             CALL QuickTPut1 (OutTxt$) : _
  1956.             EXIT SUB
  1957. '
  1958. '
  1959. ' *  THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
  1960. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
  1961. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
  1962. ' *   3.  THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
  1963. ' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
  1964. ' *      and requires security 5 or more to access
  1965.       ScriptIndex = 1
  1966.       ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
  1967.                          " " + _
  1968.                          DATE$ + _
  1969.                          " " + _
  1970.                          TIME$
  1971. * REPLACING old line(s) by new
  1972. 64110 CALL Carrier
  1973.       IF ZSubParm = -1 THEN _
  1974.          GOTO 64510
  1975.       ScriptIndex = ScriptIndex + 1
  1976.       IF ScriptIndex > ScriptMax THEN _
  1977.          GOTO 64400
  1978.       ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2)
  1979.       WasX = ZFalse
  1980.       IF LEFT$(ZOutTxt$,3) = "/FL" THEN _
  1981.          ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
  1982.          WasX = ZTrue
  1983.       CALL MetaGSR (ZOutTxt$,WasX)
  1984. * ------[ first line different ]------
  1985.       CALL SmartText (ZOutTxt$,ZFalse,WasX,ZFalse)   ' Pe 02/05/93
  1986.       WasX$ = ZOutTxt$
  1987.       ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _
  1988.          64111, _       ' catch invalid lines
  1989.          64110, _       ' : label
  1990.          64110, _       ' ! stored answer
  1991.          64420, _       ' @ abort
  1992.          64120, _       ' M macro execute
  1993.          64430, _       ' T turbo key
  1994.          64440, _       ' > goto label
  1995.          64190, _       ' < assign value
  1996.          64450, _       ' * display line
  1997.          64113, _       ' ? prompt for answer
  1998.          64114, _       ' = conditional branch
  1999.          64460, _       ' - decrease security level
  2000.          64465, _       ' + increase security level
  2001.          64470          ' & chain
  2002. * REPLACING old line(s) by new
  2003. * ------[ first line different ]------
  2004. 64111 Call GetRBBSString(151,RBBSString$)       'Pe 01/16/93
  2005.       OutTxt$ = RBBSString$                  'Pe 01/16/93
  2006.       ZOutTxt$ = OutTxt$ + LEFT$(ZOutTxt$(ScriptIndex),1)
  2007.        Call GetRBBSString(152,RBBSString$)       'Pe 01/16/93
  2008.        OutTxt$ = RBBSString$                  'Pe 01/16/93
  2009.       ZOutTxt$ = ZOutTxt$ + OutTxt$
  2010.       ZSubParm = 5
  2011.       CALL TPut
  2012.       GOTO 64510
  2013. * REPLACING old line(s) by new
  2014. 64200 ScriptIndex = 1
  2015.       CALL MetaGSR (BranchLabel$,ZFalse)
  2016. * ------[ first line different ]------
  2017.       CALL SmartText (BranchLabel$,ZFalse,ZFalse,ZFalse)   'Pe 02/06/93
  2018.       CALL AllCaps (BranchLabel$)
  2019.       CALL Trim (BranchLabel$)
  2020. * REPLACING old line(s) by new
  2021. 64400 ScriptIndex = 0
  2022.       ZWasEN$ = AppendFileName$
  2023.       CALL LockAppend
  2024.       IF ZErrCode <> 0 THEN _
  2025. * ------[ first line different ]------
  2026.        Call GetRBBSString(153,RBBSString$) : _      'Pe 01/16/93
  2027.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  2028.          ZOutTxt$ = OutTxt$ : _
  2029.          ZSubParm = 5 : _
  2030.          CALL TPut : _
  2031.          GOTO 64500
  2032. * REPLACING old line(s) by new
  2033. 64410 ScriptIndex = ScriptIndex + 1
  2034.       IF ScriptIndex > ScriptMax THEN _
  2035.          GOTO 64500
  2036.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  2037.          QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _
  2038.          GOTO 64410
  2039.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _
  2040.          LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _
  2041.          GOTO 64410
  2042.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _
  2043.          CALL PrintWorkA (QuestionSave$) : _
  2044.          CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2))
  2045.       IF ScriptIndex = 1 AND _
  2046.          AppendFileName$ <> PrevAppend$ THEN _
  2047.          CALL PrintWorkA (ZOutTxt$(ScriptIndex))
  2048.       IF ZErrCode <> 0 THEN _
  2049. * ------[ first line different ]------
  2050.        Call GetRBBSString(154,RBBSString$) : _      'Pe 01/16/93
  2051.        OutTxt$ = RBBSString$ : _                 'Pe 01/16/93
  2052.          ZOutTxt$ = OutTxt$ : _
  2053.          ZSubParm = 5 : _
  2054.          CALL TPut : _
  2055.          GOTO 64500
  2056.       GOTO 64410
  2057. * REPLACING old line(s) by new
  2058. 64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0)
  2059.       ZOK = ZTrue
  2060.       ZLastIndex = 0
  2061.       END SUB
  2062. * ------[ first line different ]------
  2063. ' ViewArc Subroutine.... deleted
  2064. * DELETING old line(s)
  2065. 64600
  2066. 64605
  2067. 64610
  2068. 64620
  2069. 64630
  2070. * REPLACING old line(s) by new
  2071. 64636 IF ZAnsIndex < ZLastIndex THEN _
  2072.          GOTO 64638
  2073. * ------[ first line different ]------
  2074.        Call GetRBBSString(155,RBBSString$)      'Pe 01/16/93
  2075.       ZOutTxt$ = RBBSString$                 'Pe 01/16/93
  2076.     CALL TopPrompt
  2077.        Call GetRBBSString(156,RBBSString$)      'Pe 01/16/93
  2078.       ZOutTxt$ = RBBSString$                  'Pe 01/16/93
  2079.     Call TopPrompt
  2080.        Call GetRBBSString(157,RBBSString$)      'Pe 01/16/93
  2081.       ZOutTxt$ = RBBSString$                  'Pe 01/16/93
  2082.     CALL TopPrompt
  2083.        Call GetRBBSString(158,RBBSString$)      'Pe 01/16/93
  2084.        ZOutTxt$ = RBBSString$ + ZPressEnter$
  2085.     CALL ColorPrompt (ZOutTxt$)
  2086. * REPLACING old line(s) by new
  2087. 64638 ZStackC = ZTrue
  2088.       ZTurboKey = -ZTurboKeyUser
  2089.       CALL PopCmdStack
  2090.       IF ZWasQ=0 OR ZSubParm < 0 THEN _
  2091.          EXIT SUB
  2092.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  2093.       CALL AllCaps (ZWasZ$)
  2094. * ------[ first line different ]------
  2095.       ZFF = INSTR("ABCFHLNTX!I",ZWasZ$)                           'RChat
  2096.       IF ZFF < 1 THEN _
  2097.          GOTO 64636
  2098.       CALL Toggle (ZFF)
  2099.       GOTO 64636
  2100.       END SUB
  2101.       SUB TopPrompt STATIC
  2102.       CALL ColorPrompt (ZOutTxt$)
  2103.       CALL QuickTPut1 (ZOutTxt$)
  2104.       END SUB
  2105. '
  2106. * REPLACING old line(s) by new
  2107. 64640 ' * SysOp function 5 - change xfer stats
  2108.       SUB CmndSysOpXfer STATIC
  2109. * ------[ first line different ]------
  2110.        Call GetRBBSString(150,RBBSString$)      'Pe 01/16/93
  2111.        OutTxt$ = RBBSString$
  2112.       CALL QuickTPut1 (OutTxt$)
  2113.       ZOutTxt$ = "Upload file total"
  2114.       GOSUB 64642
  2115.       IF LEN(ZUserIn$(1)) > 0 THEN _
  2116.          LSET ZUserUplds$ = MKI$(VAL(ZUserIn$(1)))
  2117.       ZOutTxt$ = "Upload byte total"
  2118.       GOSUB 64642
  2119.       IF LEN(ZUserIn$(1)) > 0 THEN _
  2120.          LSET ZULBytes$ = MKS$(VAL(ZUserIn$(1)))
  2121.       ZOutTxt$ = "Download file total"
  2122.       GOSUB 64642
  2123.       IF LEN(ZUserIn$(1)) > 0 THEN _
  2124.          LSET ZUserDnlds$ = MKI$(VAL(ZUserIn$(1)))
  2125.       ZOutTxt$ = "Download byte total"
  2126.       GOSUB 64642
  2127.       IF LEN(ZUserIn$(1)) > 0 THEN _
  2128.          LSET ZDlBytes$ = MKS$(VAL(ZUserIn$(1)))
  2129.       ZOutTxt$ = "Files downloaded TODAY"
  2130.       GOSUB 64642
  2131.       IF LEN(ZUserIn$(1)) > 0 THEN _
  2132.          LSET ZTodayDl$ = MKS$(VAL(ZUserIn$(1)))
  2133.       ZOutTxt$ = "Bytes downloaded TODAY"
  2134.       GOSUB 64642
  2135.       IF LEN(ZUserIn$(1)) > 0 THEN _
  2136.          LSET ZTodayBytes$ = MKS$(VAL(ZUserIn$(1)))
  2137.       EXIT SUB
  2138.