home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / 173_BAS.ZIP / RBBSSUB4.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-02-11  |  117.8 KB  |  3,315 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB4.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB4.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.:
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AnyBut         59760  Determine where a "word" begins
  18. '  AskUsers       64003  Ask users questions based on a script and save answers
  19. '  AskMore        59858  Check whether screen full
  20. '  AutoPage       60300  Check whether to notify sysop caller is on
  21. ' BadFileChar     59800  Check file name for bad character
  22. '  Bracket        59960  Puts strings around a substring
  23. '  BufFile        58400  Write a file to the user quickly
  24. '  BufString      58300  Write a string with imbedded CR/LF to the user quickly
  25. '  CheckColor     59930  Highlighting based on search string
  26. '  SearchArray    58190  Check for the occurance of a string in an array
  27. '  ColorDir       59920  Adds colorization to FMS directory entry
  28. '  ColorPrompt    59940  Colorizes prompts
  29. '  CompDate       59880+ Produces a computational data from YY, MM, DD
  30. '  ConfMail       59854  Check conference mail waiting
  31. '  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
  32. '  PackDate       59201  Compress date in string format to 2 characters
  33. '  EofComm        60000  Determine whether any chars in comm port buffer
  34. '  ExpireDate     59890  Calculate registration expiration date
  35. '  FakeXRpt       62650  Write out file transfer report for protocols that don't
  36. '  FindEnd        58770  Find where a "word" ends
  37. '  FindFile       58790  Determine whether a file exists without opening it
  38. '  FindLast       58600  Find last occurence of a string
  39. '  FMS            58200  Search the upload management system for entries
  40. '  GetAll         59780  Get list of all directories to display
  41. '  GetDirs        58895  Prompts for directories for file list/new/search cmds
  42. '  GetMsgAttr     62530  Restore attributes of original message
  43. '  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
  44. '  GlobalSrchRepl 60100  Global search and replace
  45. '  LogPDown       59400  Records download in private directory
  46. '  MarkTime       60200  Give visual feedback during lengthy process
  47. '  MetaGSR        60130  Meta statement global search and replace
  48. '  MsgImport      59698  Allow local user to import a text file to a message
  49. '  Muzak          59100  Play musical themes for different RBBS functions
  50. '  NewPassword    60668  Get a new password
  51. '  PersFile       59300  View and select personal files for downloading
  52. '  Protocol       62600  Determine if external protocols are available
  53. '  PutMsgAttr     62520  Save attributes of original message
  54. '  Remove         58210  Remove characters from within strings
  55. '  RotorsDir      58700  Searches for a file using list of subdirs
  56. '  RptTime        62540  Report date/time and time on
  57. '  SetEcho        59600  Set RBBS properly for who is to echo
  58. '  SetHiLite      59934  Set user preference on highlighting
  59. '  SetGraphic     59980  Sets graphic preference for text file display
  60. '  SmartText      58250  Process SMART TEXT control strings
  61. '  SubMenu        59500  Processes options that have sub-menus
  62. '  TimedOut       63000  Write timed exit semaphore file
  63. '  TimeLock       60150  Check for TIME LOCK on certain features
  64. '  Transfer       62624  RBBS-PC support for external protocols for file transfer
  65. '  Toggle         57000  Toggles or views user options
  66. ' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
  67. '  UnPackDate     59902  Uncompresses a 2 byte date
  68. '  UserColor      59965  Lets user set color for text and whether bold
  69. '  UserFace       59450  Processes programmable user interface
  70. '  ViewArc        64600  Display .ARC file contents to user
  71. '  PrivDoorRtn    62629  Private door exit routine
  72. '  WipeLine       58800  Wipes away a line so next prints in its place
  73. '  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
  74. '
  75. '  $INCLUDE: 'RBBS-VAR.BAS'
  76. '
  77. 57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences'
  78. ' $PAGE
  79. '
  80. '  NAME    -- Toggle
  81. '
  82. '  INPUTS  -- ToggleOption      Option to toggle or view
  83. '                               according to the following:
  84. '    ToggleOption         PREFERENCE
  85. '   Toggle   VIEW
  86. '     1       -1           Autodownload
  87. '     2       -2           Bulletin review on logon
  88. '     3       -3           Case change
  89. '     4       -4           File review on logon
  90. '     5       -5           Highlight
  91. '     6       -6           Line feeds
  92. '     7       -7           Nulls
  93. '     8       -8           TurboKey
  94. '     9       -9           Expert
  95. '    10      -10           Bell
  96. '
  97. '  OUTPUTS -- ZSubParm   passed from TPut
  98. '
  99. '  PURPOSE -- Sets or views any single user preference value
  100. '
  101.       SUB Toggle (ToggleOption) STATIC
  102.       ZSubParm = 0
  103.       IF ToggleOption < 0 THEN _
  104.          GOTO 57005
  105.       ON ToggleOption GOSUB _
  106.          57010, _         'Autodownload
  107.          57120, _         'Bulletin review on logon
  108.          57260, _         'Case change
  109.          57150, _         'File review on logon
  110.          57040, _         'Highlight
  111.          57100, _         'Line feeds
  112.          57210, _         'Nulls
  113.          57230, _         'TurboKey
  114.          57190, _         'Expert
  115.          57170            'Bell
  116.       EXIT SUB
  117. 57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
  118.       ON -ToggleOption GOSUB _
  119.          57030, _         'Autodownload
  120.          57130, _         'Bulletin review on logon
  121.          57270, _         'Case change
  122.          57160, _         'File review on logon
  123.          57050, _         'Highlight
  124.          57110, _         'Line feeds
  125.          57220, _         'Nulls
  126.          57240, _         'TurboKey
  127.          57200, _         'Expert
  128.          57180            'Bell
  129.       EXIT SUB
  130. 57010 IF ZAutoDownDesired THEN _
  131.          GOTO 57020
  132.       IF NOT ZAutoDownVerified THEN _
  133.          CALL TestUser
  134.       IF NOT ZAutoDownYes THEN _
  135.          CALL QuickTPut1 ("Your comm pgm does not support AUTODOWNLOAD") : _
  136.          ZAutoDownDesired = ZTrue
  137. 57020 ZAutoDownDesired = NOT ZAutoDownDesired
  138. 57030 ZOutTxt$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  139.      CALL QuickTPut1 (ZOutTxt$)
  140.      RETURN
  141. 57040 IF ZEmphasizeOnDef$ = "" THEN _
  142.         CALL QuickTPut1 ("Highlighting unavailable") : _
  143.         RETURN
  144.      IF NOT ZHiLiteOff THEN _
  145.         CALL QuickTPut (ZColorReset$,0)
  146.      CALL SetHiLite (NOT ZHiLiteOff)
  147.      GOSUB 57050
  148.      CALL UserColor
  149.      RETURN
  150. 57050 IF ZEmphasizeOn$ <> "" THEN _
  151.         ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  152.         ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  153.      CALL QuickTPut1 (ZEmphasizeOn$ + "Highlighting" + ZEmphasizeOff$ + _
  154.                  " " + FNOffOn$(NOT ZHiLiteOff))
  155.      RETURN
  156. 57100 ZLineFeeds = NOT ZLineFeeds
  157.       IF ZLocalUser THEN _
  158.          ZLineFeeds = ZTrue
  159. 57110 CALL QuickTPut1 ("Line Feeds " + FNOffOn$(ZLineFeeds))
  160.       CALL SetCrLf
  161.       RETURN
  162. 57120 ZCheckBulletLogon = NOT ZCheckBulletLogon
  163. 57130 ZOutTxt$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  164.            " old BULLETINS in logon"
  165.       CALL QuickTPut1 (ZOutTxt$)
  166.       RETURN
  167. 57150 ZSkipFilesLogon = NOT ZSkipFilesLogon
  168. 57160 ZOutTxt$ = MID$("CHECKSKIP",1 -5 * ZSkipFilesLogon,5) + _
  169.            " new files in logon"
  170.       CALL QuickTPut1 (ZOutTxt$)
  171.       RETURN
  172. 57170 ZPromptBell = NOT ZPromptBell
  173. 57180 ZOutTxt$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  174.       CALL QuickTPut1 (ZOutTxt$)
  175.       RETURN
  176. 57190 ZExpertUser = NOT ZExpertUser
  177.       CALL SetExpert
  178. 57200 ZOutTxt$ = MID$("NoviceExpert",1 -6 * ZExpertUser,6)
  179.       CALL QuickTPut1 (ZOutTxt$)
  180.       RETURN
  181. 57210 ZNulls = NOT ZNulls
  182.       ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
  183.       CALL SetCrLf
  184. 57220 ZOutTxt$ = "Nulls " + FNOffOn$(ZNulls)
  185.       CALL QuickTPut1 (ZOutTxt$)
  186.       RETURN
  187. 57230 ZTurboKeyUser = NOT ZTurboKeyUser
  188. 57240 CALL QuickTPut1 ("TurboKey " + FNOffOn$(ZTurboKeyUser))
  189.       RETURN
  190. 57260 ZUpperCase = NOT ZUpperCase
  191. 57270 ZOutTxt$ = "UPPER CASE " + _
  192.             MID$("and lowerONLY",1 - 9 * ZUpperCase,9)
  193.       CALL QuickTPut1 (ZOutTxt$)
  194. 57280 ZUseTPut = (ZUpperCase OR ZXOnXOff)
  195.       RETURN
  196.       END SUB
  197. '
  198. 58190 ' $SUBTITLE: 'SearchArray - subroutine to check for a string in an array'
  199. ' $PAGE
  200. '
  201. '  NAME    -- SearchArray
  202. '
  203. '  INPUTS  -- PARAMETER                      MEANING
  204. '             Element$                THE STRING TO CHECK FOR
  205. '             Array$()                THE ARRAY TO BE SEARCHED
  206. '             NumEntriesToSearch      NUMBER OF ENTRIES WITHIN IN
  207. '                                     THE ARRAY TO BE SEARCHED
  208. '
  209. '  OUTPUTS -- IsInAra                 0 = STRING NOT Found IN THE
  210. '                                         ARRAY SPECIFIED
  211. '                                     OTHERWISE IT IS THE NUMBER sOF
  212. '                                     ELEMENT WITHIN THE ARRAY THAT
  213. '                                     WAS Found TO MATCH
  214. '
  215. '  PURPOSE -- Search an array for a specified string and, if found,
  216. '             return the number of the element that matched.
  217. '
  218.       SUB SearchArray (Element$,Array$(1),NumEntriesToSearch,IsInAra) STATIC
  219.       IsInAra = 1
  220.       CALL AllCaps (Element$)
  221.       MaxTries = NumEntriesToSearch + 1
  222.       Array$(MaxTries) = Element$
  223.       WHILE Array$(IsInAra) <> Element$
  224.          IsInAra = IsInAra + 1
  225.       WEND
  226.       IF IsInAra = MaxTries THEN _
  227.          IsInAra = 0
  228.       END SUB
  229. 58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
  230. ' $PAGE
  231. '
  232. '  NAME    -- FMS
  233. '
  234. '  INPUTS  -- PARAMETER                      MEANING
  235. '             DirToSearch$          RBBS-PC "DIR" CATEGORY TO LOOK
  236. '                                     FOR
  237. '             SearchString$          STRING TO SEARCH FOR
  238. '             SearchDate$            DATE TO SEARCH FOR
  239. '             ZCategoryName$()
  240. '             ZCategoryCode$()
  241. '             ZCategoryDesc$()
  242. '             CatFound
  243. '             ZNumCategories
  244. '
  245. '  OUTPUTS -- ProcessedInFMS
  246. '             DnldFlag
  247. '
  248. '  PURPOSE -- To search the file management system and display the
  249. '             files being searched for as well as the catetory descriptions
  250. '
  251.       SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
  252.                ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
  253.                ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
  254.       DnldFlag = 0
  255.       CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
  256.       ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
  257.       IF ProcessedInFMS THEN _
  258.          ZSubParm = 5 : _
  259.          GOSUB 58202 : _
  260.          ZOutTxt$ = "Scanning directory " + _
  261.               DirToSearch$ + _
  262.               SrchDir$ + _
  263.               " - " + _
  264.               ZCategoryDesc$(CatFound) : _
  265.          CALL TPut : _
  266.          Cat$ = ZCategoryCode$(CatFound) : _
  267.          CALL DispUpDir (Cat$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
  268.       EXIT SUB
  269. 58202 ZOutTxt$ = SearchDate$
  270.       IF LEN(ZOutTxt$) > 0 THEN _
  271.          ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2)
  272.       SrchDir$ = " for " + _
  273.              SearchString$ + _
  274.              ZOutTxt$
  275.       IF LEN(SrchDir$) < 6 THEN _
  276.          SrchDir$ = ""
  277.       RETURN
  278.       END SUB
  279. 58210 ' $SUBTITLE: 'Remove - subroutine to delete a string from within a string'
  280. ' $PAGE
  281. '
  282. '  NAME    -- Remove
  283. '
  284. '  INPUTS  -- PARAMETER                      MEANING
  285. '             BADSTRING$              STRING CONTAINING CHARACTERS
  286. '                                     TO BE DELETED FROM "WasL$"
  287. '             WasL$                      STRING TO BE ALTERED
  288. '
  289. '  OUTPUTS -- WasL$                      WITH THE CHARACTERS IN
  290. '                                     "BADSTRING#" DELETED FROM IT
  291. '
  292. '  PURPOSE -- To remove all instances of the characters in
  293. '                        "BADSTRING$" from "WasL$"
  294. '
  295.       SUB Remove (WasL$,BadString$) STATIC
  296.       WasJ = 0
  297.       FOR WasI=1 TO LEN(WasL$)
  298.          IF INSTR(BadString$,MID$(WasL$,WasI,1)) = 0 THEN _
  299.             WasJ = WasJ + 1 : _
  300.             MID$(WasL$,WasJ,1) = MID$(WasL$,WasI,1)
  301.       NEXT WasI
  302.       WasL$ = LEFT$(WasL$,WasJ)
  303.       END SUB
  304. '
  305. 58250 ' $SUBTITLE: 'SmartText - smart text substitution'
  306. ' $PAGE
  307. '
  308. '  NAME    -- SmartText   (WRITTEN BY DOUG AZZARITO)
  309. '
  310. '  INPUTS  -- StringWork$        string to scan for Smart Text
  311. '             CRFound            Does this line contain a CR?
  312. '             ZSmartTextCode     Smart Text control code
  313. '
  314. '  OUTPUTS -- StringWork$        Input string with Smart replaced
  315. '
  316. '  PURPOSE -- Smart Text allows control strings in text files
  317. '             to be replaced at runtime with user info or other
  318. '             data.  The Smart Text control code is a 1-byte
  319. '             code (configurable) with a 2-byte action code.
  320. '
  321.       SUB SmartText (StringWork$, CRFound, OverStrike) STATIC
  322.       IF SmartCarry$<>"" THEN _
  323.          StringWork$ = SmartCarry$+StringWork$
  324.       Index = INSTR(StringWork$, ZSmartTextCode$)
  325.       WHILE Index > 0 AND Index < LEN(StringWork$)-1
  326.          IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _
  327.             SmartAct = 0 _
  328.          ELSE _
  329.             SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2))
  330.          IF SmartAct = 0 THEN _
  331.             WasI = 1 : _
  332.             GOTO 58254
  333.          SmartAct = (SmartAct+2)/3
  334.          ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _
  335.                            58266, 58267, 58268, 58269, 58270, _
  336.                            58271, 58272, 58273, 58274, 58275, _
  337.                            58276, 58277, 58278, 58279, 58280, _
  338.                            58281, 58282, 58283, 58284, 58285, _
  339.                            58286, 58287, 58289, 58290, 58291, _
  340.                            58292, 58293, 58294
  341.          GOSUB 58256
  342.          WasI = LEN(SmartHold$)
  343.          ReplaceLen = 3
  344.          IF OverStrike OR Overlay THEN _
  345.             IF WasI > 2 THEN _
  346.                ReplaceLen = WasI _
  347.             ELSE _
  348.                SmartHold$ = SmartHold$ + SPACE$(3 - WasI)
  349.          StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _
  350.                        MID$(StringWork$,Index+ReplaceLen)
  351. 58254    Index = INSTR(Index+WasI, StringWork$, ZSmartTextCode$)
  352.       WEND
  353.       IF Index AND (Index > LEN(StringWork$)-2) AND NOT CRFound THEN _
  354.          SmartCarry$ = MID$(StringWork$,Index) : _
  355.          StringWork$ = LEFT$(StringWork$,Index-1) : _
  356.       ELSE _
  357.          SmartCarry$ = ""
  358.       EXIT SUB
  359. 58256 IF TrimSmart THEN _
  360.          CALL Trim (SmartHold$)
  361.       RETURN
  362. 58258 ZLastSmartColor$ = SmartHold$
  363.       RETURN
  364. 58260 ZLinesPrinted = 0                     ' CS (Clear screen line count reset)
  365.       SmartHold$ = ""
  366.       RETURN
  367. 58261 ZLinesPrinted = ZPageLength           ' PB Page Break
  368.       IF ZNonStop THEN _                    ' force a 1-time pause
  369.          ZOneStop = ZTrue : _               ' if NON STOP is on
  370.          ZNonStop = ZFalse
  371.       SmartHold$ = ""
  372.       ZForceKeyboard = ZTrue
  373.       RETURN
  374. 58262 ZNonStop = ZTrue                      ' NS Non-stop
  375.       SmartHold$ = ""
  376.       RETURN
  377. 58263 IF ZGlobalSysop THEN _                ' FN First Name
  378.          SmartHold$ = ZOrigSysopFN$ _
  379.       ELSE SmartHold$ = ZFirstName$
  380.       CALL NameCaps(SmartHold$)
  381.       RETURN
  382. 58264 IF ZGlobalSysop THEN _
  383.          SmartHold$ = ZOrigSysopLN$ _
  384.       ELSE SmartHold$ = ZLastName$
  385.       CALL NameCaps(SmartHold$)
  386.       RETURN
  387. 58265 SmartHold$ = MID$(STR$(ZUserSecLevel),2)   ' SL Security level
  388.       RETURN
  389. 58266 SmartHold$ = DATE$
  390.       RETURN
  391. 58267 CALL AMorPM
  392.       SmartHold$ = ZTime$
  393.       RETURN
  394. 58268 CALL TimeRemain(MinsRemaining)
  395.       SmartHold$ = MID$(STR$(INT(MinsRemaining)),2)
  396.       RETURN
  397. 58269 CALL TimeRemain(MinsRemaining)      ' TE Time elapsed (mm:ss)
  398.       SmartHold$ = MID$(STR$(INT(ZSecsUsedSession!/60)),2)+":"+ _
  399.          MID$(STR$((ZSecsUsedSession! MOD 60)+100),3)
  400.       RETURN
  401. 58270 SmartHold$ = MID$(STR$(INT((ZTimeLockSet+0.5)/60)),2) ' TL - Time Lock period
  402.       SmartHold$ = SmartHold$ + ":"+ MID$(STR$((ZTimeLockSet MOD 60)+100),3)
  403.       RETURN
  404. 58271 SmartHold$ = MID$(STR$(ZDaysInRegPeriod),2)
  405.       RETURN                                ' RP Registration Length
  406. 58272 SmartHold$ = MID$(STR$(ZRegDaysRemaining),2)
  407.       RETURN                                ' RR Registration Remaining
  408. 58273 SmartHold$ = ZCityState$              ' CT Users CITY & STATE
  409.       RETURN
  410. 58274 SmartHold$ = ZFG1$                    ' C1 Color 1
  411.       GOTO 58258
  412. 58275 SmartHold$ = ZFG2$                    ' C2 Color 2
  413.       GOTO 58258
  414. 58276 SmartHold$ = ZFG3$                    ' C3 Color 3
  415.       GOTO 58258
  416. 58277 SmartHold$ = ZFG4$                    ' C4 Color 4
  417.       GOTO 58258
  418. 58278 SmartHold$ = ZEmphasizeOff$           ' C0 Reset color
  419.       ZLastSmartColor$ = ""
  420.       RETURN
  421. 58279 SmartHold$ = MID$(STR$(INT(ZDLToday!)),2)
  422.       RETURN                                ' DD files Dnlded TODAY
  423. 58280 SmartHold$ = MID$(STR$(INT(ZBytesToday!)),2)
  424.       RETURN                                ' BD Bytes Dnlded TODAY
  425. 58281 SmartHold$ = MID$(STR$(INT(ZDLBytes!)),2)
  426.       RETURN                                ' DB Download Bytes
  427. 58282 SmartHold$ = MID$(STR$(INT(ZULBytes!)),2)
  428.       RETURN                                ' UB Upload Bytes
  429. 58283 SmartHold$ = MID$(STR$(ZDnlds),2)     ' DL Number of Dnlds
  430.       RETURN
  431. 58284 SmartHold$ = MID$(STR$(ZUplds),2)     ' UL Number of Uplds
  432.       RETURN
  433. 58285 SmartHold$ = ZFileName$               ' FI  File Name
  434.       RETURN
  435. 58286 Overlay = ZTrue                       ' VY Overlay ON
  436.       GOTO 58288
  437. 58287 Overlay = ZFalse                      ' VN Overlay OFF
  438. 58288 SmartHold$ = ""
  439.       RETURN
  440. 58289 TrimSmart = ZTrue                     ' TY Trim Yes
  441.       GOTO 58288
  442. 58290 TrimSmart = ZFalse                    ' TN Trim No
  443.       GOTO 58288
  444. 58291 SmartHold$ = ZRBBSName$               ' BN Board Name
  445.       RETURN
  446. 58292 SmartHold$ = ZNodeID$                 ' ND Node Number
  447.       IF SmartHold$ >= "A" THEN _
  448.          SmartHold$ = MID$(STR$(ASC(SmartHold$) - 54),2)
  449.       RETURN
  450. 58293 SmartHold$ = ZSysopFirstName$          ' FS Sysops First Name
  451.       CALL NameCaps(SmartHold$)
  452.       RETURN
  453. 58294 SmartHold$ = ZSysopLastName$          ' LS Sysops First Name
  454.       CALL NameCaps(SmartHold$)
  455.       RETURN
  456.       END SUB
  457. '
  458. 58300 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF'
  459. ' $PAGE
  460. '
  461. '  NAME    -- BufString
  462. '
  463. '  INPUTS  -- PARAMETER                      MEANING
  464. '             Strng$                  STRING TO BE WRITTEN OUT
  465. '             DataSize               LENGTH OF STRING - # LEFT
  466. '                                        CHARS TO OUTPUT
  467. '
  468. '  OUTPUTS -- Strng$                  IS WRITTEN TO THE USER
  469. '
  470. '  PURPOSE -- To search the string, Strng$, for embedded carriage
  471. '             returns and line feeds and write out each line with
  472. '             the appropriate substitution (cr/lf if to the local
  473. '             screen or cr/nulls/lf if to the communications port).
  474. '
  475.       SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC
  476.       WasL = LEN(Strng$)
  477.       IF PassedDataSize < WasL THEN _
  478.          WasL = PassedDataSize
  479.       IF WasL < 1 THEN _
  480.          EXIT SUB
  481.       ZFF = ZPageLength - 1
  482.       StartByte = 1
  483.       ZRet = ZFalse
  484.       IF CarryOver THEN _
  485.          IF ASC(Strng$) = 10 THEN _
  486.             StartByte = 2 : _
  487.             CALL SkipLine (1+ZJumpSearching)
  488.       CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$)
  489.       WasL = WasL + CarryOver
  490. 58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  491.       IF CRat > 0 AND CRat < WasL THEN _
  492.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  493.       ELSE CRFound = ZFalse
  494.       EOLlen = -2 * CRFound
  495.       IF CRFound THEN _
  496.          EOD = CRat _
  497.       ELSE EOD = WasL + 1
  498.       NumBytes = EOD - StartByte
  499.       StringWork$ = MID$(Strng$,StartByte,NumBytes)
  500.       IF NOT ZDeleteInvalid THEN _
  501.          GOTO 58304
  502.       Index = INSTR(StringWork$,"[")
  503.       WasJ = LEN(StringWork$) - 1
  504.       WHILE Index > 0 AND Index < WasJ
  505.          IF MID$(StringWork$,Index + 2,1) = "]" THEN _
  506.             IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _
  507.                MID$(StringWork$,Index + 1,1) = "*"
  508.          Index = INSTR(Index + 1,StringWork$,"[")
  509.       WEND
  510. 58304 IF ZJumpSearching THEN _
  511.          Temp$ = StringWork$ : _
  512.          CALL AllCaps (Temp$) : _
  513.          HiLitePos = INSTR (Temp$,ZJumpTo$) : _
  514.          IF HiLitePos = 0 THEN _
  515.             GOTO 58307 _
  516.          ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _
  517.               ZJumpSearching = ZFalse
  518.       IF ZSmartTextCode THEN _
  519.          CALL SmartText (StringWork$, CRFound, ZFalse)
  520.       CALL QuickTPut (StringWork$, - (CRFound))
  521.       IF ZRet THEN _
  522.          EXIT SUB
  523.       IF ZLinesPrinted < ZFF THEN _
  524.          GOTO 58307
  525. 58305 CALL CheckTimeRemain (MinsRemaining)
  526.       CALL CheckCarrier
  527.       IF ZSubParm = -1 THEN _
  528.          EXIT SUB
  529.       IF ZNonStop THEN _
  530.          GOTO 58307
  531.       IF NOT CRFound THEN _
  532.          GOTO 58307
  533.       ZForceKeyboard = ZTrue
  534.       CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts)
  535.       IF ZNo THEN _
  536.          ZRet = ZTrue : _
  537.          EXIT SUB
  538. 58307 StartByte = EOD + EOLlen
  539.       IF StartByte <= WasL THEN _
  540.          GOTO 58301
  541.       END SUB
  542. 58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
  543. ' $PAGE
  544. '
  545. '  NAME    -- BufFile
  546. '
  547. '  INPUTS  -- PARAMETER                      MEANING
  548. '             FileSpec$               NAME OF THE FILE TO WRITE TO
  549. '                                                OUT TO THE USER
  550. '
  551. '  OUTPUTS -- NONE                    FILE IS WRITTEN TO THE USER
  552. '
  553. '  PURPOSE -- To display a sequential file to the user
  554. '
  555.       SUB BufFile (FilName$,AbortIndex) STATIC
  556.       CALL FindIt (FilName$)
  557.       IF NOT ZOK THEN _
  558.          GOTO 58419
  559.       ZNo = ZFalse
  560.       CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
  561.       DataSize = ZBufferSize
  562.       FIELD 2, DataSize AS SeqRec$
  563.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  564.       ZJumpLast$ = ""
  565.       ZJumpSearching = ZFalse
  566.       ZJumpSupported = ZTrue
  567.       IF NOT ZStopInterrupts THEN _
  568.          IF NOT ZConcatFIles THEN _
  569.             IF NOT ZNonStop THEN _
  570.                ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _
  571.                ZSubParm = 2 : _
  572.                CALL TPut
  573.       WasTU = 0
  574. 58405 WasTU = WasTU + 1
  575.       IF WasTU < NumRecs THEN _
  576.          GET 2,WasTU _
  577.       ELSE IF WasTU = NumRecs THEN _
  578.               GET 2,WasTU : _
  579.               WasX = INSTR(SeqRec$,CHR$(26)) : _
  580.               IF WasX = 0 OR WasX > LenLastRec THEN _
  581.                  DataSize = LenLastRec _
  582.               ELSE DataSize = WasX - 1 _
  583.            ELSE GOTO 58419
  584.       IF ZLocalUser THEN _
  585.          GOTO 58406
  586.       CALL EofComm (Char)
  587.       IF Char <> -1 THEN _
  588.          GOTO 58407            ' comm port input
  589. 58406 ZKeyboardStack$ = INKEY$
  590.       IF ZKeyboardStack$ = "" THEN _  ' no keyboard input
  591.          CALL BufString (SeqRec$,DataSize,AbortIndex) : _
  592.          GOTO 58408
  593. 58407 ZOutTxt$ = LEFT$(SeqRec$,DataSize)  ' process comm/keyboard
  594.       ZSubParm = 4
  595.       CALL TPut
  596. 58408 IF ZSubParm <> -1 AND NOT ZRet THEN _
  597.          GOTO 58405
  598. 58419 CLOSE 2
  599.       ZBypassTimeCheck = ZFalse
  600.       ZStopInterrupts = ZFalse
  601.       CALL QuickTPut (ZEmphasizeOff$,0)
  602.       ZJumpSupported = ZFalse
  603.       END SUB
  604. 58600 ' $SUBTITLE: 'FindLast - find last occurence of a string'
  605. ' $PAGE
  606. '
  607. '  NAME    -- FindLast
  608. '
  609. '  INPUTS  -- PARAMETER             MEANING
  610. '              LookIn$           STRING TO LOOK INTO
  611. '              LookFor$          STRING TO SEARCH FOR
  612. '
  613. '  OUTPUTS -- WhereFound        POSITION IN LookIn$ THAT
  614. '                                   LookFor$ Found
  615. '             NumFinds          HOW MANY OCCURENCES IN LookIn$
  616. '
  617. '  PURPOSE -- Finds last occurence of LookFor$ in LookIn$ and
  618. '             returns count of # of occurences.  If none found,
  619. '             both returned parameters are set to 0.
  620. '
  621.       SUB FindLast (LookIn$,LookFor$,WhereFound,NumFinds) STATIC
  622.       WhereFound = INSTR(LookIn$,LookFor$)
  623.       NumFinds = -(WhereFound > 0)
  624.       NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  625.       WHILE NextFound > 0
  626.          NumFinds = NumFinds + 1
  627.          WhereFound = NextFound
  628.          NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
  629.       WEND
  630.       END SUB
  631. 58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file'
  632. ' $PAGE
  633. '
  634. '  NAME    -- RotorsDir
  635. '
  636. '  INPUTS  --     PARAMETER                    MEANING
  637. '             FilName$                  FILE NAME TO LOOK FOR
  638. '             SDIR.ARA                  ARRAY OF SUBDIRECTORIES
  639. '             MaxSearch                 MAX # OF SUBDIRECTORIES
  640. '             MarkingTime               WHETHER TO MARK TIME
  641. '
  642. '  OUTPUTS -- FNAME$                    ADD SUBDIRECTORY TO THE
  643. '                                       FILE NAME IF FOUND.  OTHER-
  644. '                                       WISE DON'T.
  645. '             ZOK                       TRUE IF FILE WAS Found
  646. '
  647. '  PURPOSE -- Hunt through a list of subdirectories to determine
  648. '             if a file is in any of them.  If file is found, open
  649. '             the file as file #2, add the drive/path to the file
  650. '             name, and sets ZOK to true.  If file isn't found, set
  651. '             file name to the last subdirectory searched -- which
  652. '             should be the upload subdirectory.
  653. '
  654. '             If the library menu is selected (ZMenuIndex = 6), then
  655. '             only 2 subdirectories are searched. The first being
  656. '             the work disk and the second being the selected
  657. '             library disk.
  658. '
  659.       SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime) STATIC
  660.       ZOK = ZFalse
  661.       ZDotFlag = ZFalse
  662.       IF MarkingTime THEN _
  663.          CALL QuickTPut ("Searching for "+FilName$,0)
  664.       IF ZMenuIndex = 6 THEN _
  665.          GOTO 58705
  666.       NumSearch = 1
  667.       WasX = 0
  668.       WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _
  669.          SDirAra$(NumSearch) <> ""
  670.          IF MarkingTime THEN _
  671.             CALL MarkTime (WasX)
  672.          WasX$ = SDirAra$(NumSearch) + _
  673.               FilName$
  674.          CALL FindFile (WasX$,ZOK)
  675.          NumSearch = NumSearch + 1
  676.       WEND
  677.       IF ZFastFileSearch AND NOT ZOK THEN _
  678.          CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18) : _
  679.          IF ZErrCode = 0 THEN _
  680.             CALL TrimTrail (FilName$,".") : _
  681.             CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$) : _
  682.             ZOK = (RecFoundAt > 0) : _
  683.             IF ZOK THEN _
  684.                ZOK = ZFalse : _
  685.                CALL CheckInt (MID$(RecFound$,13,4)) : _
  686.                IF ZTestedIntValue > 0 THEN _
  687.                   CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66) : _
  688.                   IF ZErrCode = 0 AND ZTestedIntValue <= HighRec THEN _
  689.                      FIELD 2, 66 AS LocatorRec$ : _
  690.                      GET 2, ZTestedIntValue : _
  691.                      WasX$ = LEFT$(LocatorRec$,63) : _
  692.                      CALL Trim (WasX$) : _
  693.                      IF LEFT$(WasX$,2) = "M!" THEN _
  694.                         WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _
  695.                         CALL Trim (WasX$) : _
  696.                         CALL MacroExe (WasX$) : _
  697.                         ZDotFlag = ZTrue : _
  698.                         ZOK = ZFalse : _
  699.                         GOTO 58710 _
  700.                      ELSE WasX$ = WasX$ + FilName$ : _
  701.                           CALL FindFile (WasX$,ZOK)
  702.       GOTO 58710
  703. 58705 WasX$ = ZLibWorkDiskPath$ + _
  704.            FilName$
  705.       CALL FindIt (WasX$)
  706.       IF ZOK THEN _
  707.          GOTO 58710
  708.       WasX$ = ZLibDrive$ + _
  709.            FilName$
  710.       CALL FindIt (WasX$)
  711. 58710 FilName$ = WasX$
  712.       CALL SkipLine (-MarkingTime)
  713.       END SUB
  714. 58800 ' $SUBTITLE: 'WipeLine - Wipe away a line so next overprints'
  715. ' $PAGE
  716. '
  717. '  NAME    -- WipeLine
  718. '
  719. '  INPUTS  --     PARAMETER                    MEANING
  720. '                 ZCarriageReturn$
  721. '                 CharsToWipe            # OF CHARACTERS TO BLANK
  722. '                 ZNulls
  723. '
  724. '  OUTPUTS -- NONE
  725. '
  726. '  PURPOSE -- Wipe away a line and leave cursor at beginning of the
  727. '             same line so that the next line will print in its place
  728. '
  729.       SUB WipeLine (CharsToWipe) STATIC
  730.       IF ZNulls OR CharsToWipe > 79 THEN _
  731.          CALL SkipLine (1) : _
  732.          EXIT SUB
  733.       IF NOT ZLocalUser THEN _
  734.          Strng$ = ZCarriageReturn$ + SPACE$(CharsToWipe) + ZCarriageReturn$ : _
  735.          IF ZFossil THEN _
  736.             Bytes = LEN(Strng$) : _
  737.             CALL FosWrite(ZComPort,Bytes,Strng$) _
  738.          ELSE PRINT #3,Strng$
  739.       IF ZSnoop THEN _
  740.          LOCATE ,1 :  _
  741.          CALL LPrnt(SPACE$(CharsToWipe),0) : _
  742.          LOCATE ,1
  743.       IF ZF7Msg$ = "" OR _
  744.          ZF7Msg$ = "NONE" OR _
  745.          NOT ZSysopNext THEN _
  746.          EXIT SUB
  747.       ZBypassTimeCheck = ZTrue
  748.       CALL BufFile (ZF7Msg$,WasX)
  749.       END SUB
  750. 58895 ' $SUBTITLE: 'GetDirs -- Prompt for directories to search'
  751. ' $PAGE
  752. '
  753. '  NAME    -- GetDirs
  754. '
  755. '  INPUTS  --     PARAMETER                    MEANING
  756. '                 ZDirPrompt$             BASE OF DIRECTORY PROMPT
  757. '                 ShowHelp               Whether to display help
  758. '                                            on entry
  759. '  OUTPUTS --     ZUserIn$
  760. '                 ZWasQ
  761. '
  762. '  PURPOSE -- Prompt for directories to search
  763. '
  764.       SUB GetDirs (ShowHelp) STATIC
  765.       IF ShowHelp AND (ZAnsIndex >= ZLastIndex ) THEN _
  766.          GOTO 58902
  767. 58900 ZOutTxt$ = ZDirPrompt$
  768.       ZMacroMin = 2
  769.       CALL PopCmdStack
  770.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  771.          EXIT SUB
  772.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  773.       IF ZUserIn$(ZAnsIndex) = "Q" THEN _
  774.          ZWasQ = 0 : _
  775.          EXIT SUB
  776.       ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
  777.       IF ZWasA = 0 THEN _
  778.          EXIT SUB
  779.       IF ZWasA > 8 THEN _
  780.          IF ZAnsIndex < ZLastIndex THEN _
  781.             GOTO 58900 _
  782.          ELSE GOTO 58902
  783.       IF ZWasA = 7 THEN _
  784.          ZExtendedOff = NOT ZExtendedOff _
  785.       ELSE ZExtendedOff = (ZWasA > 3)
  786.       CALL QuickTPut1 ("Extended directory display "+MID$("ON OFF",1-3*ZExtendedOff,3))
  787.       GOTO 58900
  788. 58902 ZFileName$ = ZCurDirPath$ + ZDirPrefix$ + _
  789.                     "." + ZDirExtension$
  790.       GDefault$ = MID$(" GC",ZWasGR + 1, 1)
  791.       CALL Graphic (GDefault$,ZFileName$)
  792.       CALL BufFile (ZFileName$,ZAnsIndex)
  793.       GOTO 58900
  794.       END SUB
  795. '
  796. 58950 ' $SUBTITLE: 'ConvertDir -- Converts coded response to right directory'
  797. ' $PAGE
  798. '
  799. '  NAME    -- ConvertDir
  800. '
  801. '  INPUTS  --     PARAMETER                    MEANING
  802. '                 Start               ELEMENT TO BEGIN WITH
  803. '                 ZUserIn$            ARRAY TO CONVERT
  804. '                 ZWasQ               Last ELEMENT TO CONVERT
  805. '
  806. '  OUTPUTS --     ZUserIn$            CONVERTED DIRECTORY LIST
  807. '
  808. '  PURPOSE -- Let the user put in a short standard string for a directory
  809. '
  810. '
  811.       SUB ConvertDir (Start) STATIC
  812.       FOR WasI=Start TO ZLastIndex
  813.          CALL AllCaps (ZUserIn$(WasI))
  814.          IF ZUserIn$(WasI)="U" THEN _
  815.             ZUserIn$(WasI) = ZUpldDirCheck$
  816.          IF ZUserIn$(WasI) = "A" THEN _
  817.             ZUserIn$(WasI) = "ALL"
  818.       NEXT
  819.       END SUB
  820. 59100 ' $SUBTITLE: 'Muzak - subroutine to PLAY ZMusic'
  821. ' $PAGE
  822. '
  823. '  NAME    -- Muzak
  824. '
  825. '  INPUTS  --   PARAMETER     MEANING
  826. '                       1   PLAY CONSIDER YOURSELF(OPENING SCREEN)
  827. '                       2   PLAY WALK RIGHT IN(NEW USERS)
  828. '                       3   PLAY DRAGNET (SECURITY VIOLATION)
  829. '                       4   PLAY GOODBYE CHARLIE (GOODBYE)
  830. '                       5   PLAY TAPS (ACCESS DENIED)
  831. '                       6   PLAY OOM PAH PAH (DOWNLOAD)
  832. '                       7   PLAY THNKS FOR MEMORIES(UPLOAD)
  833. '
  834. '  OUTPUTS -- NONE
  835. '
  836. '  PURPOSE -- Provide sysops and the visually impaired with
  837. '             auditory feedback on what RBBS-PC is doing
  838. '
  839.       SUB Muzak (PassedArg) STATIC
  840.       ZFF = PassedArg
  841.       ZSubParm = 0
  842.       IF (NOT ZSnoop) OR (NOT ZMusic) OR ZLocalUserMode THEN _
  843.          EXIT SUB
  844.       ON ZFF GOTO 59102,59104,59106,59108,59110,59112,59114
  845.       EXIT SUB
  846. 59102 '---[Introduction CONSIDER YOURSELF]---
  847.     Music$ = "MBT180A4B-8B-8B-8B-2.G4A8F2"
  848.     PLAY "O2 X" + VARPTR$(Music$)
  849.     EXIT SUB
  850. 59104 '---[New User WALK RIGHT IN]---
  851.     Music1$ = "MBT180G4G4D2G8F+8F8E2A8B8"
  852.     Music2$ = "C8C+8D8C8"
  853.     Music3$ = "B4G2"
  854.     PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
  855.     EXIT SUB
  856. 59106 '---[Security Violation DRAGNET THEME]---
  857.      Music$ = "MBT120C2D8E-4C2.C2D8E-4C4G-2."
  858.      PLAY "O2 X" + VARPTR$(Music$)
  859.      EXIT SUB
  860. 59108 '---[Goodbye GOODBYE CHARLIE]---
  861.       Music$ = "MBT180B-2.G2.F4D2."
  862.       PLAY "O2 X" + VARPTR$(Music$)
  863.       EXIT SUB
  864. 59110 '---[Access Denied TAPS]---
  865.       Music1$ = "MBT90F8A16"
  866.       Music2$ = "C4."
  867.       Music3$ = "A4F4C2.C8C16F2"
  868.       PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
  869.       EXIT SUB
  870. 59112 '---[Download OOM PAH PAH]---
  871.        Music$ = "MBT180F4A4A4C4A4A4G4A4G4D2"
  872.        PLAY "O2 X" + VARPTR$(Music$)
  873.        EXIT SUB
  874. 59114 '---[Upload THANKS FOR THE MEMORIES]---
  875.        Music1$ = "MBT180C2."
  876.        Music2$ = "A8G8F4D2"
  877.        PLAY "O3 X" + VARPTR$(Music1$) + "O2 X" + VARPTR$(Music2$)
  878.        END SUB
  879. 59200 ' $SUBTITLE: 'TwoByteDate -- subroutine to put date in 2 bytes'
  880. ' $PAGE
  881. '
  882. '  NAME    -- TwoByteDate
  883. '
  884. '  INPUTS  --   PARAMETER     MEANING
  885. '                  Year       FOUR DIGIT YEAR (I.E. 1987)
  886. '                  WasMM      MONTH
  887. '                  WasDD      DAY
  888. '                Result$      LOCATION TO PLACE THE Result
  889. '
  890. '  OUTPUTS -- Result$       TWO BYTE COMPRESSED DATE FOR USE IN
  891. '                           A RANDOM RECORD
  892. '
  893. '  PURPOSE -- Compress a WasY,ZMsgPtr,WasD date into two characters
  894. '
  895.       SUB TwoByteDate (Year,WasMM,WasDD,Result$) STATIC
  896.       Result$ = CHR$(((Year - 1980) * 2) OR - ((WasMM AND 8) <> 0)) + _
  897.                 CHR$((WasMM AND NOT 8) * 32 + WasDD)
  898.       END SUB
  899. 59201 ' $SUBTITLE: 'PackDate -- subroutine to Compress STRING DATE'
  900. ' $PAGE
  901. '
  902. '  NAME    -- PackDate
  903. '
  904. '  INPUTS  --   PARAMETER     MEANING
  905. '                 Strng$    String Date (mm-dd-yyyy)
  906. '
  907. '  OUTPUTS --    Result$    TWO BYTE COMPRESSED DATE FOR USE IN
  908. '                                      A RANDOM RECORD
  909. '
  910. '  PURPOSE -- Compress an 8-character date into two characters
  911. '
  912.       SUB PackDate (Strng$,Result$) STATIC
  913.       IF LEN(Strng$) < 8 THEN _
  914.          EXIT SUB
  915.       Year = VAL(MID$(Strng$,7))
  916.       WasMM = VAL(Strng$)
  917.       WasDD = VAL(MID$(Strng$,4))
  918.       CALL TwoByteDate (Year,WasMM,WasDD,Result$)
  919.       END SUB
  920. 59202 ' $SUBTITLE: 'UnPackDate -- subroutine to UNCompress DATE'
  921. ' $PAGE
  922. '
  923. '  NAME    -- UnPackDate
  924. '
  925. '  INPUTS  --   PARAMETER      MEANING
  926. '             CompressedDate$ Date in 2 byte compressed form
  927. '
  928. '  OUTPUTS --     Year           Year of compressed date
  929. '                 WasMM          Month of compressed date
  930. '                 WasDD          Day of compressed date
  931. '             DisplayDate$       8 char display date (mm-dd-yyyy)
  932. '
  933. '  PURPOSE -- Uncompress a 2 char date to get Y,M,D & display
  934. '
  935.       SUB UnPackDate (CompressedDate$,Year,WasMM,WasDD,DisplayDate$) STATIC
  936.       CALL GetYMD (CompressedDate$,1,Year)
  937.       CALL GetYMD (CompressedDate$,2,WasMM)
  938.       CALL GetYMD (CompressedDate$,3,WasDD)
  939.       DisplayDate$ = RIGHT$("00" + MID$(STR$(WasMM),2),2) + _
  940.                       "-" + _
  941.                       RIGHT$("00" + MID$(STR$(WasDD),2),2) + _
  942.                       "-" + _
  943.                       RIGHT$(STR$(Year),2)
  944.       END SUB
  945. 59204 ' $SUBTITLE: 'GetYMD -- subroutine to unpack a two-byte date'
  946. ' $PAGE
  947. '
  948. '  NAME    -- GetYMD
  949. '
  950. '  INPUTS  --   PARAMETER     MEANING
  951. '                 TwoByte$    PACKED TWO-BYTE DATE FIELD
  952. '                   YMD       1 = YEAR
  953. '                             2 = MONTH
  954. '                             3 = DAY
  955. '                 Result      LOCATION TO PLACE THE Result
  956. '
  957. '  OUTPUTS -- Result        FOUR DIGIT Result OF UNPAKING THE DATE
  958. '
  959. '  PURPOSE -- Unpack a compressed two-byte date field
  960. '
  961.       SUB GetYMD (TwoByte$,YMD,Result) STATIC
  962.       ON YMD GOTO 59206,59210,59215
  963.       EXIT SUB
  964. 59206 Result = (ASC(TwoByte$)AND NOT 1) / 2 + 1980
  965.       EXIT SUB
  966. 59210 Result = FIX((ASC(MID$(TwoByte$,2)) / 32)) OR ((ASC(TwoByte$) AND 1) * 8)
  967.       EXIT SUB
  968. 59215 Result = ASC(MID$(TwoByte$,2)) AND NOT 224
  969.       END SUB
  970. 59300 ' $SUBTITLE: 'PersFile - processes requests for personal files'
  971. ' $PAGE
  972. '
  973. '  NAME    -- PersFile
  974. '
  975. '  INPUTS  --     PARAMETER           MEANING
  976. '                 PersonalCat$     CATEGORY IN DIR FOR CALLER
  977. '                 ZPersonalLen      # CHARS IN PERSONAL CATEGORY
  978. '  OUTPUTS -- NONE UP ZDnlds
  979. '
  980. '  PURPOSE -- Show caller what personal files have for downloading,
  981. '             verify and process requests for downloads
  982. '
  983.       SUB PersFile (PersonalCat$,DnldFlag) STATIC
  984.       CALL FindIt (ZPersonalDir$)
  985. 59302 IF NOT ZOK THEN _
  986.          CALL QuickTPut1 ("No personal files available") : _
  987.          ZLastIndex = 0 : _
  988.          EXIT SUB
  989.       GOSUB 59338
  990.       IF LOF(2) < WasL THEN _
  991.         ZOK = ZFalse : _
  992.         GOTO 59302
  993.       ZUserIn$(0) = ""
  994.       MaxPrint = ZPageLength - 1
  995.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  996.       ZStopInterrupts = ZFalse
  997.       IF Downloading THEN _
  998.          Downloading = ZFalse : _
  999.          PersIndex = DnldFlag : _
  1000.          DnldFlag = 0 : _
  1001.          GOTO 59306
  1002. 59303 ZOutTxt$ = "Download what: L)ist, * = new, or file(s)" + _
  1003.            ZPressEnterExpert$
  1004.       ZMacroMin = 99
  1005.       ZStackC = ZTrue
  1006.       CALL PopCmdStack
  1007.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1008.          ZLastIndex = 0 : _
  1009.          EXIT SUB
  1010. 59304 SelectedProtocol$ = ""
  1011.       IF ZLastIndex > 1 THEN _
  1012.          IF LEN(ZUserIn$(ZLastIndex)) = 1 THEN _
  1013.             SelectedProtocol$ = ZUserIn$(ZLastIndex) : _
  1014.             ZLastIndex = ZLastIndex - 1
  1015.       IF LEN(ZUserIn$(ZAnsIndex)) > 1 THEN _
  1016.          GOTO 59330
  1017.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  1018.       ON INSTR("L*",ZUserIn$(ZAnsIndex)) GOTO 59305,59327
  1019.       GOTO 59303
  1020. 59305 PersIndex = LastRec
  1021.       WasL = ZFalse
  1022. 59306 IF PersIndex < 1 THEN _
  1023.          IF WasL THEN _
  1024.             GOTO 59303 _
  1025.          ELSE _
  1026.             ZOutTxt$ = "No files for you" : _
  1027.                  CALL QuickTPut1 (ZOutTxt$) : _
  1028.               GOTO 59303
  1029.       GET #2,PersIndex
  1030.       PersIndex = PersIndex - 1
  1031.       IF ZSysop THEN _
  1032.          GOTO 59320
  1033.       IF ASC(PrivateCat$) = 32 THEN _
  1034.          IF ZUserSecLevel < VAL(PrivateCat$) THEN _
  1035.             GOTO 59306 _
  1036.          ELSE GOTO 59308
  1037.       IF PersonalCat$ <> PrivateCat$ THEN _
  1038.          GOTO 59306
  1039. 59308 WasL = ZTrue
  1040.       FilName$ = ZPersonalDrvPath$ + _
  1041.                  LEFT$(PartToPrint$,12)
  1042. 59320 ZOutTxt$ = PartToPrint$
  1043.       CALL ColorDir (ZOutTxt$,"Y")
  1044.       IF PersonalStatus$ = "*" AND LEFT$(ZOutTxt$,1) <> " " THEN _
  1045.          ZOutTxt$ = "*" + ZOutTxt$ _
  1046.       ELSE ZOutTxt$ = " " + ZOutTxt$
  1047.       IF ZLocalUser THEN _
  1048.          GOTO 59322
  1049.       CALL EofComm (Char)
  1050.       IF Char <> -1 THEN _
  1051.          GOTO 59323            ' comm port input
  1052. 59322 ZKeyboardStack$ = INKEY$
  1053. 59323 ZSubParm = 5
  1054.       CALL TPut
  1055.       IF ZRet THEN _
  1056.          GOTO 59303
  1057.       IF ZSubParm = -1 THEN _
  1058.          GOTO 59335
  1059. 59324 IF ZLinesPrinted <= MaxPrint THEN _
  1060.          GOTO 59306
  1061.       CALL TimeRemain (MinsRemaining)
  1062.       IF MinsRemaining <= 0 THEN _
  1063.          ZSubParm = -1 : _
  1064.          GOTO 59335
  1065.       CALL Carrier
  1066.       IF ZSubParm = -1 THEN _
  1067.          GOTO 59335
  1068.       IF ZNonStop THEN _
  1069.          GOTO 59306
  1070. 59325 IF PersIndex > 0 THEN _
  1071.          ZOutTxt$ = "MORE: [Y],N,C or download what (* = new)" _
  1072.       ELSE GOTO 59303
  1073.       ZNoAdvance = ZTrue
  1074.       ZMacroMin = 99
  1075.       ZStackC = ZTrue
  1076.       CALL PopCmdStack
  1077.       IF ZSubParm = -1 THEN _
  1078.          GOTO 59335
  1079.       ZNonStop = (ZNonStop OR INSTR(" Cc",ZUserIn$) > 1)
  1080.       IF PersIndex < 1 AND ZWasQ = 0 THEN _
  1081.          GOTO 59335
  1082.       CALL WipeLine (78)
  1083.       IF ZNo THEN _
  1084.          GOTO 59303
  1085.       IF LEN(ZUserIn$(ZAnsIndex)) > 2 THEN _
  1086.          GOTO 59304
  1087.       GOTO 59306
  1088. 59327 PersIndex = LastRec        ' handle new files
  1089.       ZLastIndex = 0
  1090.       WHILE PersIndex > 0 AND  ZLastIndex < UBOUND(ZUserIn$)
  1091.          GET 2,PersIndex
  1092.          IF PersonalCat$ <> PrivateCat$ THEN _
  1093.             GOTO 59329
  1094.          IF PersonalStatus$ <> "*" THEN _
  1095.             GOTO 59329
  1096.          ZLastIndex = ZLastIndex + 1
  1097.          WasI = ZLastIndex
  1098.          GOSUB 59336
  1099.          IF ZOK THEN _
  1100.             WasX$ = MID$(STR$(PersIndex),2) : _
  1101.             ZUserIn$(0) = ZUserIn$(0) + _
  1102.                     WasX$ + _
  1103.                     SPACE$(5 - LEN(WasX$)) _
  1104.          ELSE ZLastIndex = ZLastIndex - 1
  1105. 59329    PersIndex = PersIndex - 1
  1106.       WEND
  1107.       IF ZLastIndex = 0 THEN _
  1108.          ZOutTxt$ = "No new files for you" : _
  1109.          CALL QuickTPut1 (ZOutTxt$) : _
  1110.          GOTO 59303
  1111.       ZAnsIndex = 1
  1112.       GOTO 59332
  1113. 59330 WasI = ZAnsIndex              ' handle list of files
  1114.       WHILE WasI <= ZLastIndex
  1115.          ZOK = ZFalse
  1116.          WasJ = LastRec + 1
  1117.          CALL AllCaps (ZUserIn$(WasI))
  1118.          WasX = INSTR(ZUserIn$(WasI),".")
  1119.          IF WasX = 0 THEN _
  1120.             ZUserIn$(WasI) = ZUserIn$(WasI) + "." + ZDefaultExtension$ _
  1121.          ELSE IF WasX = LEN(ZUserIn$(WasI)) THEN _
  1122.                  ZUserIn$(WasI) = LEFT$(ZUserIn$(WasI),WasX-1)
  1123.          WHILE WasJ > 1 AND NOT ZOK
  1124.             WasJ = WasJ - 1
  1125.             GET #2,WasJ
  1126.             IF (PersonalCat$ = PrivateCat$ OR _
  1127.                (ASC(PrivateCat$) = 32 AND _
  1128.                 ZUserSecLevel => VAL(PrivateCat$))) THEN _
  1129.                    ZOK = (ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1))
  1130.          WEND
  1131.          IF ZOK THEN _
  1132.             GOSUB 59336 : _
  1133.             IF ZOK THEN _
  1134.                WasX$ = MID$(STR$(WasJ),2) : _
  1135.                ZUserIn$(0) = ZUserIn$(0) + _
  1136.                        WasX$ + _
  1137.                        SPACE$(5 - LEN(WasX$))
  1138.          IF NOT ZOK THEN _
  1139.             CALL QuickTPut1 (ZUserIn$(WasI) + " not found - omitted") : _
  1140.             FOR WasK = WasI + 1 TO ZLastIndex : _
  1141.                ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
  1142.             NEXT : _
  1143.             ZLastIndex = ZLastIndex - 1 : _
  1144.             WasI = WasI - 1
  1145.          WasI = WasI + 1
  1146.       WEND
  1147.       IF ZLastIndex = 0 THEN _
  1148.          GOTO 59303
  1149. 59332 DnldFlag = PersIndex          ' set protocol
  1150.       Downloading = ZTrue
  1151.       ZWasB = 1
  1152.       IF SelectedProtocol$ = "" THEN _
  1153.          IF ZPersonalProtocol$ <> " " THEN _
  1154.             SelectedProtocol$ = ZPersonalProtocol$
  1155.       IF SelectedProtocol$ <> "" THEN _
  1156.          ZLastIndex = ZLastIndex + 1 : _
  1157.          ZUserIn$(ZLastIndex) = SelectedProtocol$
  1158.       EXIT SUB
  1159. 59335 CLOSE 2
  1160.       EXIT SUB
  1161. 59336 ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
  1162.       CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
  1163.       IF ZOK THEN _
  1164.          ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
  1165.       ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
  1166.                       ((ZUserSecLevel < ZMinSecToView) OR _
  1167.                        NOT ZCanDnldFromUp),ZTrue) : _
  1168.            GOSUB 59338
  1169.       RETURN
  1170. 59338 CLOSE 2
  1171.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  1172.       IF ZShareIt THEN _
  1173.          OPEN ZPersonalDir$ FOR RANDOM SHARED AS #2 LEN=WasL _
  1174.       ELSE OPEN "R",2,ZPersonalDir$,WasL
  1175.       FIELD #2,33 + ZMaxDescLen AS PartToPrint$, _
  1176.                ZPersonalLen    AS PrivateCat$, _
  1177.                1               AS PersonalStatus$, _
  1178.                2               AS Filler$
  1179.       LastRec = LOF(2) / WasL
  1180.       RETURN
  1181.       END SUB
  1182. 59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads'
  1183. ' $PAGE
  1184. '
  1185. '  NAME    -- LogPDown
  1186. '
  1187. '  INPUTS  --   PARAMETER     MEANING
  1188. '
  1189. '  OUTPUTS --
  1190. '
  1191. '  PURPOSE -- Puts a "!" in place of an "*" in private directory
  1192. '             after downloaded
  1193. '
  1194.       SUB LogPDown (PrivateDnld,ZDwnIndex) STATIC
  1195.       IF NOT PrivateDnld THEN _
  1196.          EXIT SUB
  1197.       ZWasEN$ = ZPersonalDir$
  1198.       WasBX = &H4
  1199.       ZSubParm = 9
  1200.       CALL FileLock
  1201.       WasL = 36 + ZMaxDescLen + ZPersonalLen
  1202.       CLOSE 2
  1203.       IF ZShareIt THEN _
  1204.          OPEN ZWasEN$ FOR RANDOM SHARED AS #2 LEN=WasL _
  1205.       ELSE OPEN "R",2,ZPersonalDir$,WasL
  1206.       FIELD #2,WasL AS PersonalRec$
  1207.       ZWasA = VAL(MID$(ZUserIn$(0),5 * (ZDwnIndex - 1) + 1,5))
  1208.       GET #2,ZWasA
  1209.       MID$(PersonalRec$,WasL-2,1) = "!"
  1210.       PUT #2,ZWasA
  1211.       CALL UnLockAppend
  1212.       END SUB
  1213. 59450 ' $SUBTITLE: 'UserFace - handles programmable user interface'
  1214. ' $PAGE
  1215. '
  1216. '  NAME    --  UserFace
  1217. '
  1218. '  INPUTS  --  PARAMETER                   MEANING
  1219. '              GDefault$            GRAPHICS DEFAULT TO USE
  1220. '              ZCurPUI$             PUI TO USE
  1221. '              ZExpertUser          WHETHER CALL IN EXPERT MODE
  1222. '
  1223. '  OUTPUTS --  ZWasQ
  1224. '              ZUserIn$()
  1225. '              ZWasZ$
  1226. '
  1227. '  PURPOSE --  When sysop overrides RBBS-PC's default user
  1228. '              interface (provides a MAIN.PUT), this routine
  1229. '              reads in the table of specifications, presents
  1230. '              the sysop menu, presents the prompt, verifies
  1231. '              that a valid option has been picked, determines
  1232. '              whether the option is another PUI, and passes
  1233. '              back choices to be processed.
  1234. '
  1235.       SUB UserFace (GDefault$) STATIC
  1236. 59455 IF ZPrevPUI$ = ZCurPUI$ THEN _
  1237.          GOTO 59458
  1238. 59456 ZFileName$ = ZCurPUI$
  1239.       CALL Graphic (GDefault$,ZFileName$)
  1240.       IF NOT ZOK THEN _
  1241.          CALL UpdtCalr ("Missing menu " + ZCurPUI$,2) : _
  1242.          ZCurPUI$ = ZPrevPUI$ : _
  1243.          GOTO 59456
  1244.       ZPrevPUI$ = ZCurPUI$
  1245.       LINE INPUT #2,ZFileName$
  1246.       LINE INPUT #2,Prompt$
  1247.       INPUT #2,ValidChoice$,ActualCommands$
  1248.       LINE INPUT #2,MenuChoice$
  1249.       LINE INPUT #2,MenuName$
  1250.       LINE INPUT #2,QuitCmd$
  1251.       LINE INPUT #2,QuitPrompt$
  1252.       LINE INPUT #2,QuitSubCmds$
  1253.       LINE INPUT #2,QuitMenuOpt$
  1254.       LINE INPUT #2,QuitMenus$
  1255.       CALL Graphic (GDefault$,ZFileName$)
  1256.       CALL BreakFileName (ZFileName$,MenuDrvPath$,WasX$,ZWasY$,ZTrue)
  1257.       MenuToDisplay$ = ZFileName$
  1258.       WasJ = INSTR(ZOrigCommands$,"?")
  1259.       IF WasJ < 1 THEN _
  1260.          WasX$ = "" _
  1261.       ELSE WasX$ = MID$(ZAllOpts$,WasJ,1)
  1262. 59458 IF ZExpertUser THEN _
  1263.          GOTO 59461
  1264. 59460 ZNonStop = (ZPageLength < 1)
  1265.       CALL BufFile (MenuToDisplay$,WasX)
  1266. 59461 ZOutTxt$ = Prompt$
  1267.       ZTurboKey = -ZTurboKeyUser
  1268.       CALL PopCmdStack
  1269.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1270.          EXIT SUB
  1271.       IF ZWasQ = 0 THEN _
  1272.          GOTO 59458
  1273. 59462 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1274.       CALL AllCaps (ZWasZ$)
  1275.       WasJ = INSTR(ValidChoice$,ZWasZ$)
  1276.       IF WasJ < 1 THEN _
  1277.          GOTO 59492
  1278.       ZWasZ$ = MID$(ActualCommands$,WasJ,1)
  1279.       ZUserIn$(ZAnsIndex) = ZWasZ$
  1280.       WasJ = INSTR(MenuChoice$,ZWasZ$)
  1281.       IF WasJ > 0 THEN _
  1282.          ZCurPUI$ = MID$(MenuName$,1 + (WasJ - 1) * 7,7) : _
  1283.          GOTO 59490
  1284.       IF ZWasZ$ = WasX$ THEN _
  1285.          GOTO 59460
  1286.       IF ZWasZ$ <> QuitCmd$ THEN _
  1287.          EXIT SUB
  1288. 59470 ZOutTxt$ = QuitPrompt$
  1289.       ZTurboKey = -ZTurboKeyUser
  1290.       CALL PopCmdStack
  1291.       IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1292.          EXIT SUB
  1293.       IF ZWasQ = 0 THEN _
  1294.          GOTO 59458
  1295. 59480 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1296.       CALL AllCaps (ZWasZ$)
  1297.       WasJ = INSTR(QuitSubCmds$,ZWasZ$)
  1298.       IF WasJ < 1 THEN _
  1299.          GOTO 59470
  1300.       WasJ = INSTR(QuitMenuOpt$,ZWasZ$)
  1301.       IF WasJ > 0 THEN _ 'quit to submenu
  1302.          ZCurPUI$ = MID$(QuitMenus$,1 + (WasJ - 1) * 7,7) : _
  1303.          GOTO 59490
  1304.       ZUserIn$(ZAnsIndex) = QuitCmd$ 'valid but not menu-send to RBBS
  1305.       EXIT SUB
  1306. 59490 CALL Remove (ZCurPUI$," ")
  1307.       ZCurPUI$ = MenuDrvPath$ + _
  1308.                      ZCurPUI$ + _
  1309.                      ".PUI"
  1310.       GOTO 59455
  1311. 59492 CALL QuickTPut1 (ZWasZ$ + " not valid choice")
  1312.       GOTO 59460
  1313.       END SUB
  1314. 59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus'
  1315. ' $PAGE
  1316. '
  1317. '  NAME    -- SubMenu
  1318. '
  1319. '  INPUTS  --   PARAMETER     MEANING
  1320. '             PassedPrompt$   PROMPT TO DISPLAY
  1321. '             CurMenu$        NOVICE MENU TO DISPLAY
  1322. '             FrontOpt$       DRIVE/PATH/PREFIX OF FILE
  1323. '                             NEEDED FOR TYPED OPTION
  1324. '             BackOpt$        SUFFIX/EXTENSION OF FILE
  1325. '                             NEEDED WITH TYPED OPTION
  1326. '             ReturnOn$       LETTERS CALLING PROGRAM WANTS
  1327. '                             CONTROL ON
  1328. '             GRDefault$      GRAPHICS DEFAULT TO USE
  1329. '             VerifyInMenu    WHETHER VERIFY OPTION IS IN MENU
  1330. '             AllMenuOK       WHETHER CONTROL SHOULD RETURN
  1331. '                             WHEN IN MENU
  1332. '             ZAnsIndex       # OF COMMANDS IN TYPE AHEAD
  1333. '             RequireInMenu   WHETHER OPTION MUST BE IN MENU
  1334. '
  1335. '  OUTPUTS -- ZWasZ$              OPTION PICKED
  1336. '             ZFileName$      NAME OF FILE SUPPORTING OPTION
  1337. '
  1338. '
  1339. '  PURPOSE -- Handles menus - including conference, bulletins,
  1340. '             doors, questionnaires.  Supports sub-menus (i.e.
  1341. '             an option on the menu that invokes another menu)
  1342. '
  1343.       SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _
  1344.                   BackOpt$,ReturnOn$,GRDefault$,VerifyInMenu, _
  1345.                   AllMenuOK,RequireInMenu,BackOpt2$) STATIC
  1346. 59510 ZFileName$ = CurMenu$
  1347.       CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
  1348.       MenuFront$ = MenuDrv$ + WasX$
  1349.       CALL Graphic (GRDefault$,ZFileName$)
  1350.       CurMenuVer$ = ZFileName$
  1351.       ZStopInterrupts = ZFalse
  1352.       IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
  1353.          GOTO 59520
  1354. 59515 CALL BufFile (CurMenuVer$,ZAnsIndex) 'show menu
  1355. 59520 ZOutTxt$ = PassedPrompt$            'get response
  1356.       CALL PopCmdStack
  1357.       IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  1358.          EXIT SUB
  1359. 59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1360.       CALL AllCaps (ZWasZ$)
  1361.       IF INSTR(ReturnOn$,ZWasZ$) THEN _  'check whether calling pgm wants
  1362.          EXIT SUB
  1363.       IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
  1364.          GOTO 59515
  1365.       IF INSTR(ZWasZ$,".") > 0 THEN _
  1366.          GOTO 59532
  1367.       FPre$ = FrontOpt$
  1368.       GOSUB 59538
  1369.       IF (WasBF < 2) AND (NOT ZOK) THEN _
  1370.          FPre$ = MenuDrv$ : _
  1371.          GOSUB 59538 : _
  1372.          IF NOT ZOK THEN _    ' support shared options
  1373.             FPre$ = MenuFront$ : _
  1374.             GOSUB 59538
  1375.       IF NewMenu THEN _
  1376.          NewMenu = ZFalse : _
  1377.          GOTO 59515
  1378.       IF ZOK THEN _
  1379.          EXIT SUB
  1380. 59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _
  1381.          EXIT SUB
  1382.       GOSUB 59547
  1383.       GOTO 59515
  1384. 59538 FilName$ = FPre$ + ZWasZ$
  1385.       CALL BadFile (FilName$,WasBF)
  1386.       IF WasBF > 1 THEN _
  1387.          ZOK = ZFalse : _
  1388.          RETURN
  1389.       ZFileName$ = FilName$ + _
  1390.                    BackOpt$
  1391.       CALL Graphic (GRDefault$,ZFileName$)
  1392.       IF NOT ZOK THEN _
  1393.          IF BackOpt2$ <> "" THEN _
  1394.             ZFileName$ = FilName$ + _
  1395.                          BackOpt2$ : _
  1396.             CALL Graphic (GRDefault$,ZFileName$)
  1397.       IF ZOK THEN _
  1398.          IF ZSysop OR (NOT RequireInMenu) THEN _
  1399.             RETURN _
  1400.          ELSE CALL WordInFile (CurMenu$,ZWasZ$,Found) : _
  1401.               IF Found THEN _
  1402.                  RETURN _
  1403.               ELSE GOTO 59540
  1404.       IF (NOT VerifyInMenu) THEN _
  1405.          GOTO 59540
  1406.       CALL WordInFile (CurMenu$,ZWasZ$,Found)  'verify against menu itself
  1407.       IF Found THEN _
  1408.          IF AllMenuOK THEN _
  1409.             RETURN
  1410. 59540 WasX$ = FPre$ + _
  1411.            ZWasZ$ + _
  1412.            ".MNU" 'check whether option is a menu
  1413.       ZFileName$ = WasX$
  1414.       CALL Graphic (GRDefault$,ZFileName$)
  1415.       IF ZOK THEN _
  1416.          NewMenu = ZTrue : _
  1417.          CurMenuVer$ = ZFileName$ : _
  1418.          CurMenu$ = WasX$ : _
  1419.          CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _
  1420.          MenuFront$ = MenuDrv$ + WasX$ : _
  1421.          RETURN
  1422.       IF VerifyInMenu AND Found AND NOT RequireInMenu THEN _
  1423.          CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _
  1424.                        CurMenu$ + " but not found",1)
  1425.       RETURN
  1426. 59547 CALL QuickTPut1 ("No such option " + ZWasZ$)
  1427.       ZLastIndex = 0
  1428.       RETURN
  1429. 59548 END SUB
  1430. 59600 ' $SUBTITLE: 'SetEcho -- subroutine to reset who echoes'
  1431. ' $PAGE
  1432. '
  1433. '  NAME    -- SetEcho
  1434. '
  1435. '  INPUTS  --   PARAMETER     MEANING
  1436. '               NewEcho$   The new echo option
  1437. '               ZLocalUser
  1438. '
  1439. '  OUTPUTS -- ZRemoteEcho   Whether RBBS is to echo what a
  1440. '                           remote caller types
  1441. '
  1442. '  PURPOSE -- Resets who echos.  "R" is for RBBS to echo.
  1443. '             "I" is for intermediate host to echo.
  1444. '             "C" is for caller's communication pgm to echo.
  1445. '
  1446.       SUB SetEcho (NewEcho$) STATIC
  1447.       IF NewEcho$ = PrevEcho$ THEN _
  1448.          EXIT SUB
  1449.       IF NewEcho$ = "R" THEN _
  1450.          ZRemoteEcho = (NOT ZLocalUser) _
  1451.       ELSE ZRemoteEcho = ZFalse
  1452.       IF ZLocalUser THEN _
  1453.          GOTO 59602
  1454.       IF NewEcho$ = "I" THEN _
  1455.           IF ZFossil THEN _
  1456.              Bytes = LEN(ZHostEchoOn$) : _
  1457.              CALL FosWrite(ZComPort,Bytes,ZHostEchoOn$) : _
  1458.              GOTO 59602 _
  1459.           ELSE PRINT #3,ZHostEchoOn$; : _
  1460.                GOTO 59602
  1461.       IF PrevEcho$ = "I" THEN _
  1462.           IF ZFossil THEN _
  1463.              Bytes = LEN(ZHostEchoOff$) : _
  1464.              CALL FosWrite(ZComPort,Bytes,ZHostEchoOff$) _
  1465.           ELSE PRINT #3,ZHostEchoOff$;
  1466. 59602 PrevEcho$ = NewEcho$
  1467.       END SUB
  1468. 59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
  1469. ' $PAGE
  1470. '
  1471. '  NAME    -- MsgImport
  1472. '
  1473. '  INPUTS  --   PARAMETER     MEANING
  1474. '               MaxLines     MAXIMUM # OF LINES
  1475. '               MaxLen       MAXIMUM LENGTH OF A LINE
  1476. '               NumLines     NUMBER OF LINES ALREADY IN MESSAGE
  1477. '               LineAra$     ARRAY OF LINES IN MESSAGE
  1478. '
  1479. '  OUTPUTS --   NumLines
  1480. '               LineAra$
  1481. '
  1482. '  PURPOSE -- Allows local user to append a text file to
  1483. '             a message.   Will word wrap if needed.
  1484. '
  1485.       SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
  1486.       IF NOT (ZLocalUser OR ZSysop) THEN _
  1487.          CALL QuickTPut1 ("Only for SYSOPS/local users") : _
  1488.          EXIT SUB
  1489. 59700 ZOutTxt$ = "Import what file" + ZPressEnter$
  1490.       CALL PopCmdStack
  1491.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  1492.          EXIT SUB
  1493.       CALL FindIt (ZUserIn$(ZAnsIndex))
  1494.       IF NOT ZOK THEN _
  1495.          CALL QuickTPut1 (ZUserIn$(ZAnsIndex) + " not found") : _
  1496.          GOTO 59700
  1497.       WHILE NOT EOF(2) AND NumLines < MaxLines
  1498.          NumLines = NumLines + 1
  1499.          LINE INPUT #2,LineAra$(NumLines)
  1500.       WEND
  1501.       CLOSE 2
  1502.       CALL WordWrap (MaxLen,NumLines,LineAra$())
  1503.       END SUB
  1504. 59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message'
  1505. ' $PAGE
  1506. '
  1507. '  NAME    -- WordWrap
  1508. '
  1509. '  INPUTS  --   PARAMETER     MEANING
  1510. '               MaxLen       MAXIMUM LENGTH OF A SINGLE LINE
  1511. '               NumLines     NUMBER OF LINES IN A MESSAGE
  1512. '               LineAra$     ALL THE LINES IN THE MESSAGE
  1513. '
  1514. '  OUTPUTS --   NumLines
  1515. '               LineAra$
  1516. '
  1517. '  PURPOSE -- Batch adjusts a message, wrapping lines if
  1518. '             needed.  Preserves paragraph structure.
  1519. '
  1520.       SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC
  1521.       WasJ = 1
  1522.       WHILE WasJ <= NumLines
  1523.          ReFormatted = ZFalse
  1524. 59704    CALL TrimTrail (LineAra$(WasJ)," ")
  1525.          WasK = LEN(LineAra$(WasJ))
  1526.          IF WasK <= MaxLen THEN _
  1527.             GOTO 59705
  1528.          CALL FindLast (LineAra$(WasJ)," ",LastPos,HowMany)
  1529.          CALL AnyBut (LineAra$(WasJ),1,">",WasX)
  1530.          CALL AnyBut (LineAra$(WasJ+1),1,">",Temp)
  1531.          IF LEFT$(LineAra$(WasJ + 1),2) = "  " OR ((Temp > 0) AND WasX <> Temp) THEN _
  1532.             FOR WasK = NumLines TO WasJ + 1 STEP -1 : _
  1533.                LineAra$(WasK + 1) = LineAra$(WasK) : _
  1534.             NEXT : _
  1535.             NumLines = NumLines + 1 : _
  1536.             LineAra$(WasJ + 1) = ""
  1537.          IF WasX > 1 THEN _
  1538.             IF MID$(LineAra$(WasJ),WasX,1) = " " THEN _
  1539.                WasX = WasX + 1
  1540.          WasX$ = LEFT$(LineAra$(WasJ),WasX-1)
  1541.          IF LastPos < 1 THEN _
  1542.             LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),MaxLen) + MID$(LineAra$(WasJ + 1),WasX) : _
  1543.             LineAra$(WasJ) = LEFT$(LineAra$(WasJ),MaxLen - 1) + "-" _
  1544.          ELSE ZUserIn$ = LEFT$(" ", - (LEN(LineAra$(WasJ + 1)) > 0)) : _
  1545.               LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),LastPos + 1) + ZUserIn$ + MID$(LineAra$(WasJ + 1),WasX) : _
  1546.               LineAra$(WasJ) = LEFT$(LineAra$(WasJ),LastPos - 1)
  1547.          ReFormatted = ZTrue
  1548.          GOTO 59704
  1549. 59705    IF ReFormatted THEN _
  1550.             IF WasJ = NumLines THEN _
  1551.                NumLines = NumLines + 1
  1552.          WasJ = WasJ + 1
  1553.       WEND
  1554.       END SUB
  1555. 59760 ' $SUBTITLE: 'AnyBut -- subroutine to find where a word begins'
  1556. ' $PAGE
  1557. '
  1558. '  NAME    -- AnyBut
  1559. '
  1560. '  INPUTS  --   PARAMETER     MEANING
  1561. '               Strng$        STRING TO SEARCH FOR WORDS
  1562. '               Beg           BYTE POSITION IN Strng$ TO
  1563. '                             BEGIN SEARCHING
  1564. '               SkipChars$    CHARACTERS TO SKIP OVER WHEN
  1565. '                                SEARCHING
  1566. '
  1567. '  OUTPUTS --   WhereIs      BYTES POSITION IN Strng$ WHERE
  1568. '                             WORD BEGINS
  1569. '
  1570. '  PURPOSE -- Parser.   Finds where a "word" begins, where
  1571. '             any character will be accepted as the beginning of a
  1572. '             word except those listed in SKIP.CHAR$
  1573. '
  1574.       SUB AnyBut (Strng$, Beg, SkipChars$, WhereIs) STATIC
  1575.       WasX$ = Strng$ + _
  1576.            CHR$(0)
  1577.       WhereIs = Beg
  1578.       IF WhereIs < 1 THEN _
  1579.          WhereIs = 1
  1580.       WHILE INSTR(SkipChars$, MID$(WasX$, WhereIs, 1)) > 0
  1581.          WhereIs = WhereIs + 1
  1582.       WEND
  1583.       IF WhereIs > LEN(Strng$) THEN _
  1584.          WhereIs = 0
  1585.       END SUB
  1586. 59770 ' $SUBTITLE: 'FindEnd -- subroutine to find where a word ends'
  1587. ' $PAGE
  1588. '
  1589. '  NAME    -- FindEnd
  1590. '
  1591. '  INPUTS  --   PARAMETER     MEANING
  1592. '               Strng$        STRING TO SEARCH FOR WORDS
  1593. '               Beg          POSITION IN Strng$ TO BEGIN SEARCH
  1594. '               StopWith$    CHARACTERS THAT TERMINATE A WORD
  1595. '
  1596. '  OUTPUTS      WhereIs      POSITION IN Strng$ WHERE WORD ENDS
  1597. '                             (I.E. THE Last CHARACTER OF THE WORD)
  1598. '
  1599. '  PURPOSE -- Parser.   Finds where a "word" ends, where
  1600. '             any character will be counted as in a word
  1601. '             except for those in StopWith$ or when the end of
  1602. '             the string is found.
  1603. '
  1604.       SUB FindEnd (Strng$, Beg, StopWith$, WhereIs) STATIC
  1605.       ZWasB = Beg
  1606.       IF ZWasB < 1 THEN _
  1607.          ZWasB = 1
  1608.       IF ZWasB > LEN(Strng$) THEN _
  1609.          WasX$ = StopWith$ _
  1610.       ELSE WasX$ = MID$(Strng$, ZWasB) + _
  1611.                 StopWith$
  1612.       WasI = 1
  1613.       WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1614.       WHILE WasX = 0
  1615.          WasI = WasI + 1
  1616.          WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
  1617.       WEND
  1618.       WhereIs = WasI - 1 + ZWasB - 1
  1619.       END SUB
  1620. 59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
  1621. ' $PAGE
  1622. '
  1623. '  NAME    -- GetAll
  1624. '
  1625. '  INPUTS  --   PARAMETER     MEANING
  1626. '               LookIn$       NAME OF FILE TO SEARCH
  1627. '               DIR.EXT$      MAIN DIRECTORY EXTENSION TO USE
  1628. '               StartPos      Last POSITION USED IN ARRAY
  1629. '
  1630. '  OUTPUTS      StartPos     Last ELEMENT USED IN ARRAY
  1631. '               LoadInto$    ARRAY TO LOAD ELEMENTS Found
  1632. '
  1633. '  PURPOSE -- Creates a list (LoadInto$) of all directories
  1634. '             to be listed when ZWasA)ll is selected for a directory.
  1635. '             All uses config parm, which can be either a single
  1636. '             directory or list of directories (begin with "@").
  1637. '
  1638.       SUB GetAll (LoadInto$(1), StartPos) STATIC
  1639.       IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
  1640.          StartPos = StartPos + 1 : _
  1641.          LoadInto$(StartPos) = ZMasterDirName$ : _
  1642.          EXIT SUB
  1643.       ZOK = ZFalse
  1644.       IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
  1645.          CALL FindIt(MID$(ZMasterDirName$,2))
  1646.       IF NOT ZOK THEN _
  1647.          CALL QuickTPut1 ("No dirs defined for A)ll") : _
  1648.          EXIT SUB
  1649.       MaxLoad = UBOUND(LoadInto$, 1)
  1650.       StartSort = StartPos + 1
  1651.       WHILE NOT EOF(2) AND StartPos < MaxLoad
  1652.          LINE INPUT #2, ZOutTxt$
  1653.          StartPos = StartPos + 1
  1654.          LoadInto$(StartPos) = ZOutTxt$
  1655.       WEND
  1656.       CLOSE 2
  1657.       END SUB
  1658. 59800 ' $SUBTITLE: 'BadFileChar -- checks file for illegal char'
  1659. ' $PAGE
  1660. '
  1661. '  NAME    --  BadFileChar
  1662. '
  1663. '  INPUTS  --  PARAMETER         MEANING
  1664. '               FilName$         NAME OF FILE TO CHECK
  1665. '
  1666. '  OUTPUTS --  IsOK            WHETHER NAME OK
  1667. '
  1668. '  PURPOSE --  Part of test for file's existence.  If bad
  1669. '              character in name, can't exist.
  1670. '
  1671.       SUB BadFileChar (FilName$,IsOK) STATIC
  1672.       WasL = LEN(FilName$)
  1673.       IF WasL > 2 THEN _
  1674.          IF INSTR(3,FilName$,":") > 0 THEN _
  1675.             IsOK = ZFalse : _
  1676.             EXIT SUB
  1677.       WasX$ = FilName$ + "="
  1678.       WasI = 1
  1679.       WHILE INSTR("/[]|<>+=;, ?*",MID$(WasX$,WasI,1)) = 0 AND ASC(MID$(WasX$,WasI)) < 128
  1680.          WasI = WasI + 1
  1681.       WEND
  1682.       IsOK = WasI > WasL
  1683.       END SUB
  1684. '
  1685. 59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
  1686. ' $PAGE
  1687. '
  1688. '  NAME    -- ConfMail
  1689. '
  1690. '  INPUTS  -- PARAMETER        MEANING
  1691. '         SKIP.CONFIRM         Whether to skip confirm of option
  1692. '         ZConfMailList$       File of user/message pairs to check
  1693. '         ZActiveUserFile$     Active user file (restored on exit)
  1694. '         ZActiveMessageFile$  Active msg file (restored)
  1695. '  OUTPUTS -- None
  1696. '
  1697. '  PURPOSE -- Quicking scans message header record to get
  1698. '             last msg # and user record to get whether any
  1699. '             new mail and last msg read, reports both, using
  1700. '             highlighting if new mail to caller.
  1701. '
  1702.       SUB ConfMail (MailCheckConfirm) STATIC
  1703.       SkipJoinUnjoin = ZNonStop
  1704.       IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
  1705.          CALL FindIt (ZConfMailList$) _
  1706.       ELSE ZOK = ZFalse
  1707.       IF NOT ZOK THEN _
  1708.          EXIT SUB
  1709.       IF MailCheckConfirm THEN _
  1710.          ZOutTxt$ = "Check conferences for mail ([Y],N)" : _
  1711.          ZTurboKey = -ZTurboKeyUser : _
  1712.          CALL PopCmdStack : _
  1713.          IF ZNo OR ZSubParm < 0 THEN _
  1714.             EXIT SUB
  1715.       CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
  1716.       CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
  1717.       CALL SkipLine (1)
  1718.       CALL QuickTPut1 ("Checking Message Bases since last on...")
  1719.       AnyMail = ZFalse
  1720.       ZStopInterrupts = ZFalse
  1721.       WasA1$ = ZActiveUserFile$
  1722.       MsgFileSave$ = ZActiveMessageFile$
  1723.       TempIndivValue$ = ""
  1724.       UserFileIndexSave = ZUserFileIndex
  1725.       UserRecordHold$ = ZUserRecord$
  1726.       ZOK = ZTrue
  1727. 59852 IF EOF(2) OR NOT ZOK THEN _
  1728.          GOTO 59854
  1729.          CALL ReadAny
  1730.          ZActiveUserFile$ = ZOutTxt$
  1731.          CALL ReadAny
  1732.          IF ZErrCode > 0 THEN _
  1733.             GOTO 59854
  1734.          ZActiveMessageFile$ = ZOutTxt$
  1735.          CALL FindFile (ZActiveUserFile$,ZOK)
  1736.          IF NOT ZOK THEN _
  1737.             GOTO 59854
  1738.          CALL OpenUser (HighestUserRecord)
  1739.          FIELD 5, 128 AS ZUserRecord$
  1740.          CALL FindFile (ZActiveMessageFile$,ZOK)
  1741.          IF NOT ZOK THEN _
  1742.             GOTO 59854
  1743.          CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
  1744.                         0,0,HighestUserRecord,_
  1745.                         Found,HoldUserFileIndex,ZWasSL)
  1746.          IF NOT Found THEN _
  1747.             GOTO 59852
  1748.          CALL OpenMsg
  1749.          FIELD 1, 128 AS ZMsgRec$
  1750.          GET 1,1
  1751.          AnyMail = ZTrue
  1752.          WasX = CVI(MID$(ZUserRecord$,57,2))
  1753.          WasX = (WasX AND 512) > 0
  1754.          CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
  1755.          InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
  1756.          IF InCur THEN _
  1757.             ZWasA = ZLastMsgRead _
  1758.          ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
  1759.          ZWasB = VAL(LEFT$(ZMsgRec$,8))
  1760.          WasZ = (ZWasB - ZWasA)
  1761.          IF WasZ < 0 THEN _
  1762.             ZWasA = 0 : _
  1763.             WasZ = ZWasB _
  1764.          ELSE IF WasZ = 0 THEN _
  1765.                  WasX = ZFalse
  1766.          ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
  1767.          ZWasSL = LEN(ZOutTxt$)
  1768.          ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$
  1769.          ZWasSL = LEN(CurPre$)
  1770.          IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
  1771.             Conf$ = "MAIN" _
  1772.          ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
  1773.          ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
  1774.          IF WasX THEN _
  1775.             WasX$ = ZEmphasizeOn$ : _
  1776.             ZWasZ$ = ZEmphasizeOff$ _
  1777.          ELSE WasX$ = "" : _
  1778.               ZWasZ$ = ""
  1779.          ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s): " + _
  1780.               WasX$ + MID$(" None *Some*",-6 * WasX + 1,6) + " to you" + ZWasZ$
  1781.          ZSubParm = 5
  1782.          CALL TPut
  1783.          IF SkipJoinUnjoin THEN _
  1784.             CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
  1785.             GOTO 59853
  1786.          ZTurboKey = -ZTurboKeyUser
  1787.          CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse)
  1788.          IF ZNo THEN _
  1789.             GOTO 59854
  1790.          WasX$ = LEFT$(ZUserIn$(1),1)
  1791.          CALL AllCaps (WasX$)
  1792.          IF WasX$ = "J" THEN _
  1793.             ZHomeConf$ = Conf$ : _
  1794.             GOTO 59854
  1795.          IF WasX$ = "U" THEN _
  1796.             IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
  1797.                CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _
  1798.             ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
  1799.                  ZUserFileIndex = HoldUserFileIndex : _
  1800.                  ZSubParm = 6 : _
  1801.                  CALL FileLock : _
  1802.                  PUT 5, HoldUserFileIndex : _
  1803.                  ZSubParm = 8 : _
  1804.                  CALL FileLock : _
  1805.                  CALL QuickTPut1 ("Omitted you from " + Conf$)
  1806. 59853 IF NOT ZRet THEN _
  1807.          GOTO 59852
  1808. 59854 ZActiveUserFile$ = WasA1$
  1809.       CALL OpenUser (HighestUserRecord)
  1810.       FIELD 5, 128 AS ZUserRecord$
  1811.       IF (NOT ZRet) AND NOT AnyMail THEN _
  1812.          CALL QuickTPut1 ("You have not joined any conferences")
  1813.       ZUserFileIndex = UserFileIndexSave
  1814.       LSET ZUserRecord$ = UserRecordHold$
  1815.       ZActiveMessageFile$ = MsgFileSave$
  1816.       CALL OpenMsg
  1817.       FIELD 1, 128 AS ZMsgRec$
  1818.       GET 1,1
  1819.       ZNonStop = (ZPageLength > 0)
  1820.       END SUB
  1821. 59858 ' $SUBTITLE: 'AskMore -- pauses when possible screen full'
  1822. ' $PAGE
  1823. '
  1824. '  NAME    -- AskMore
  1825. '
  1826. '  INPUTS  --   PARAMETER     MEANING
  1827. '               ExtraPrompt$  STRING TO ADD TO MORE PROMPT AT END
  1828. '               OverWrite     WHETHER TO WIPE AWAY PROMPT
  1829. '
  1830. '  OUTPUTS --   ZUserIn$()
  1831. '               ZNo
  1832. '
  1833. '  PURPOSE -- Determines whether need to pause if screen full.
  1834. '             And, if so, asks the appropriate question.  If non-
  1835. '             stop, at least check for carrier present.
  1836. '
  1837.       SUB AskMore (ExtraPrompt$, OverWrite, CheckLines,AbortIndex,CantInterrupt) STATIC
  1838.       ZNo = ZFalse
  1839.       IF CheckLines THEN _
  1840.          WasX = -ZDisplayAsUnit*ZUnitCount -(NOT ZDisplayAsUnit)*ZLinesPrinted : _
  1841.          IF WasX < ZPageLength OR (ZPageLength = 0) THEN _
  1842.             ZWasQ = 0 : _
  1843.             EXIT SUB
  1844.       IF ZOneStop THEN _
  1845.          ZOneStop = ZFalse : _
  1846.          ZNonStop = ZTrue : _
  1847.          GOTO 59860
  1848.       IF ZNonStop THEN _
  1849.          ZLinesPrinted = 0 : _
  1850.          CALL CheckCarrier : _
  1851.          IF ZKeyboardStack$ = "" AND ZCommPortStack$ = "" THEN _
  1852.             EXIT SUB _
  1853.          ELSE ZNonStop = ZFalse
  1854. 59860 CALL QuickTPut (ZEmphasizeOff$,0)
  1855.       IF CantInterrupt THEN _
  1856.          ZTurboKey = 2 : _
  1857.          ZForceKeyboard = ZTrue : _
  1858.          ZOutTxt$ = "Press Any Key to continue" _
  1859.       ELSE GOSUB 59870 : _
  1860.            ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
  1861.       WasX = LEN(ZOutTxt$) + 2
  1862.       ZNoAdvance = OverWrite
  1863.       ZSubParm = 1
  1864.       IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
  1865.          ZTurboKey = -ZTurboKeyUser
  1866.       ZMacroMin = 2
  1867.       CALL TGet
  1868.       IF ZSubParm = -1 THEN _
  1869.         EXIT SUB
  1870.       ZTurboKey = ZFalse
  1871.       ZWasDF$ = ZUserIn$ (1)
  1872.       CALL AllCaps (ZWasDF$)
  1873.       WasI = INSTR(";C;A;",";"+ZWasDF$+";")
  1874.       IF WasI = 1 THEN _
  1875.          ZNonStop = ZTrue : _
  1876.          ZWasQ = 0
  1877.       CALL WipeLine (WasX + LEN(ZUserIn$))
  1878.       IF NOT ZHiLiteOff THEN _
  1879.          CALL QuickTPut (ZLastSmartColor$,0)
  1880.       IF CantInterrupt THEN _
  1881.          ZNo = ZFalse : _
  1882.          EXIT SUB
  1883.       IF WasI = 3 THEN _
  1884.          AbortIndex = 32000
  1885.       IF ZNo THEN _
  1886.          ZKeyboardStack$ = "" : _
  1887.          ZCommPortStack$ = "" : _
  1888.          ZLastSmartColor$ = ""
  1889.       IF NOT ZJumpSupported THEN _
  1890.          EXIT SUB
  1891.       IF ZWasDF$ = "J" THEN _
  1892.          IF ZWasQ > 1 THEN _
  1893.             ZUserIn$ = ZUserIn$(2) : _
  1894.             GOTO 59866 _
  1895.          ELSE ZOutTxt$ = "Jump to what text" + ZPressEnterExpert$ : _
  1896.               CALL PopCmdStack : _
  1897.               IF ZWasQ = 0 THEN _
  1898.                  EXIT SUB _
  1899.               ELSE GOTO 59866
  1900.       IF ZWasDF$ <> "R" THEN _
  1901.          EXIT SUB
  1902.       ZUserIn$ = ZJumpLast$
  1903. 59866 ZJumpTo$ = ZUserIn$
  1904.       CALL AllCaps (ZJumpTo$)
  1905.       ZJumpSearching = ZTrue
  1906.       ZJumpLast$ = ZJumpTo$
  1907.       EXIT SUB
  1908. 59870 Temp$ = ""
  1909.       IF NOT ZJumpSupported THEN _
  1910.          RETURN
  1911.       IF ZJumpLast$ = "" THEN _
  1912.          Temp$ = LEFT$(",J)ump",2+4*(ZExpertUser+1)) _
  1913.       ELSE IF ZExpertUser THEN _
  1914.               Temp$ = ",J,R=" + ZJumpLast$ _
  1915.            ELSE Temp$ = ",J)ump,R)ejump=" + ZJumpLast$
  1916.       RETURN
  1917.       END SUB
  1918. 59880 ' $SUBTITLE: 'CompDate -- subroutine to compute elased days'
  1919. ' $PAGE
  1920. '
  1921. '  NAME    -- CompDate
  1922. '
  1923. '  INPUTS  --   PARAMETER     MEANING
  1924. '                   Year        YEAR
  1925. '                   WasMM       MONTH
  1926. '                   WasDD       DAY
  1927. '                 Result!    LOCATION TO PLACE THE Result
  1928. '
  1929. '  OUTPUTS -- Result!        COMPUTE COMPUTATIONAL DATE
  1930. '
  1931. '  PURPOSE -- Computes a computational date from YEAR, MONTH, DAY.
  1932. '             Results may be used to compute the number of elapsed
  1933. '             days between two dates.  You may pass a 2 or 4 digit
  1934. '             year, but for meaningful results, be consistent
  1935. '
  1936.       SUB CompDate (Year,WasMM,WasDD,Result!) STATIC
  1937.       IF WasMM < 1 OR WasMM > 12 THEN _
  1938.          WasMM = 1
  1939.       Result! = Year * 365.0 + _
  1940.                 INT((Year - 1) / 4) + _
  1941.                 (WasMM - 1) * 28 + _
  1942.                 VAL(MID$("000303060811131619212426",(WasMM - 1) * 2 + 1,2)) - _
  1943.                 ((WasMM > 2) AND ((Year MOD 4) = 0)) + _
  1944.                 WasDD
  1945.       END SUB
  1946. 59890 ' $SUBTITLE: 'ExpireDate -- subroutine to display expiration date'
  1947. ' $PAGE
  1948. '
  1949. '  NAME    -- ExpireDate
  1950. '
  1951. '  INPUTS  --   PARAMETER           MEANING
  1952. '             RegDate!    COMPUTATIONAL REGISTRATION DATE
  1953. '             RegPeriod   DAYS IN REGISTRATION PERIOD
  1954. '
  1955. '  OUTPUTS -- ExpDate$             DISPLAYABLE EXPIRATION DATE
  1956. '
  1957. '  PURPOSE -- Computes/creates a displayable registration
  1958. '             expiration date using registration date and days in
  1959. '             registration period.
  1960. '
  1961.       SUB ExpireDate (RegDate!,RegPeriod,ExpDate$) STATIC
  1962.       ExpDate! = RegDate! + RegPeriod
  1963.       ExpireYear = INT((ExpDate! - ExpDate! / 1461) / 365)
  1964.       ExpireDay = ExpDate! - (ExpireYear * 365.0 + INT((ExpireYear -1)/4))
  1965.       ExpireMonth = -((ExpireYear MOD 4)<>0) * _
  1966.                       (1 - (ExpireDay > 31) - (ExpireDay > 59) - _
  1967.                       (ExpireDay > 90) - (ExpireDay >120) - _
  1968.                       (ExpireDay > 151) - (ExpireDay > 181) - _
  1969.                       (ExpireDay > 212) - (ExpireDay > 243) - _
  1970.                       (ExpireDay > 273) - (ExpireDay > 304) - _
  1971.                       (ExpireDay > 334)) - ((ExpireYear MOD 4) = 0) * _
  1972.                       (1 - (ExpireDay > 31) - (ExpireDay > 60) - _
  1973.                       (ExpireDay > 91) - (ExpireDay >121) - _
  1974.                       (ExpireDay > 152) - (ExpireDay > 182) - _
  1975.                       (ExpireDay > 213) - (ExpireDay > 243) - _
  1976.                       (ExpireDay > 274) - (ExpireDay > 305) - _
  1977.                       (ExpireDay > 335))
  1978.       ExpireDay = (ExpireDay - ((ExpireMonth - 1) * 28 + _
  1979.          VAL(MID$("000303060811131619212426",(ExpireMonth -1) * 2 + 1,2)))) + _
  1980.          ((ExpireMonth > 2) AND ((ExpireYear MOD 4) = 0))
  1981.       ExpDate$ = RIGHT$("0" + MID$(STR$(ExpireMonth),2),2) + _
  1982.                   "/" + _
  1983.                   RIGHT$("0" + MID$(STR$(ExpireDay),2),2) + _
  1984.                   "/" + _
  1985.                   RIGHT$(STR$(ExpireYear),2)
  1986.       END SUB
  1987. 59920 ' $SUBTITLE: 'ColorDir - builds a color FMS directory string'
  1988. ' $PAGE
  1989. '
  1990. '  NAME    --  ColorDir
  1991. '
  1992. '  INPUTS  --  PARAMETER                   MEANING
  1993. '               Strng$              String to alter
  1994. '               FMSDir$            "Y" FOR FMS DIR
  1995. '                                  "N" FOR PERSONAL Download
  1996. '
  1997.       SUB ColorDir (Strng$,FMSDir$) STATIC
  1998.       IF ZWasGR < 2 THEN _
  1999.          EXIT SUB
  2000.       IF FMSDir$ = "N" THEN _
  2001.          GOTO 59921
  2002. '
  2003. ' INSERT COLOR FOR FILENAME
  2004. '
  2005.       ON INSTR("\ *",LEFT$(Strng$,1)) GOTO 59924,59922,59923
  2006. 59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _
  2007.                ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen)
  2008.       EXIT SUB
  2009. 59922 Strng$ = ZDR4$ + Strng$
  2010.       EXIT SUB
  2011. 59923 Strng$ = ZEmphasizeOff$ + Strng$
  2012. 59924 END SUB
  2013. 59930 ' $SUBTITLE: 'CheckColor - highlights based on search string'
  2014. ' $PAGE
  2015. '
  2016. '  NAME    --  CheckColor
  2017. '
  2018. '  INPUTS  --  PARAMETER                   MEANING
  2019. '              LookFor$           String that triggers highlight
  2020. '              LookIn$            String being searched
  2021. '              EndColor$          Terminating color
  2022. '
  2023. '  OUTPUTS --  Strng$              Revised string
  2024. '
  2025. '  PURPOSE --  Adds highlighting to a string within a string.
  2026. '              Respects previous colorization.
  2027.       SUB CheckColor (LookIn$,LookFor$,PassedEndColor$) STATIC
  2028.       IF LookFor$ = "" THEN _
  2029.          EXIT SUB
  2030.       WasX$ = LookIn$
  2031.       CALL AllCaps (WasX$)
  2032.       StartColor = INSTR(WasX$,LookFor$)
  2033.       IF StartColor < 1 THEN _
  2034.          EXIT SUB
  2035.       EndColor$ = PassedEndColor$
  2036.       IF EndColor$ = "" THEN _
  2037.          EndColor$ = ZEmphasizeOff$ : _
  2038.          CALL FindLast (LEFT$(LookIn$,StartColor-1),ZEscape$,WhereFound,WasJ) : _
  2039.          IF WhereFound > 0 THEN _
  2040.             WasJ = INSTR(WhereFound,LookIn$,"m") : _
  2041.             IF WasJ > 0 THEN _
  2042.                EndColor$ = MID$(LookIn$,WhereFound,WasJ-WhereFound+1)
  2043.       CALL Bracket (LookIn$,StartColor,StartColor + LEN(LookFor$)-1,ZEmphasizeOn$,EndColor$)
  2044.       END SUB
  2045. 59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference'
  2046. ' $PAGE
  2047. '
  2048. '  NAME    --  SetHiLite
  2049. '
  2050. '  INPUTS  --  PARAMETER                   MEANING
  2051. '              SetTo              New value (True or False)
  2052. '              ZEmphasizeOnDef$   String turns emphasize on
  2053. '              ZEmphasizeOffDef$  String turns emphasize off
  2054. '
  2055. '  OUTPUTS --  ZHiLiteOff       Callers preference on Hilite
  2056. '              ZEmphasizeOn$       String to use for emphasis
  2057. '              ZEmphasizeOff$      String to use after emphasis
  2058. '
  2059.       SUB SetHiLite (SetTo) STATIC
  2060.       ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo)
  2061.       IF ZHiLiteOff THEN _
  2062.          ZEmphasizeOn$ = "" : _
  2063.          ZEmphasizeOff$ = "" : _
  2064.          ZFG1$ = "" : _
  2065.          ZFG2$ = "" : _
  2066.          ZFG3$ = "" : _
  2067.          ZFG4$ = "" _
  2068.       ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _
  2069.            ZFG1$ = ZFG1Def$ : _
  2070.            ZFG2$ = ZFG2Def$ : _
  2071.            ZFG3$ = ZFG3Def$ : _
  2072.            ZFG4$ = ZFG4Def$
  2073.       END SUB
  2074. 59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts'
  2075. ' $PAGE
  2076. '
  2077. '  NAME    --  ColorPrompt
  2078. '
  2079. '  INPUTS  --  PARAMETER                   MEANING
  2080. '              Strng$              String to colorize
  2081. '              ZHiLiteOff          Whether highlighting is off
  2082. '              ZEmphasizeOn$       String to use for emphasis
  2083. '              ZEmphasizeOff$      String to use after emphasis
  2084. '
  2085. '  OUTPUTS --  Strng$              Colorized string
  2086. '
  2087. '  PURPOSE -- colorizes a string based on sysop settings
  2088. '             and the string.
  2089. '                        [...] is the default - put in emphasis
  2090. '                        <...> options to type - put in ZFG4$
  2091. '                        and first two preceeding words use ZFG1$ and ZFG2$
  2092. '                        options identified on right by ) and on
  2093. '                        left by space or comma - put in ZFG4$
  2094. '
  2095.       SUB ColorPrompt (Strng$) STATIC
  2096.       IF ZHiLiteOff THEN _
  2097.          EXIT SUB
  2098.       AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0)
  2099.       WasX = INSTR(Strng$,"<")
  2100.       IF WasX > 0 THEN _
  2101.          GOTO 59943
  2102.       WasX = INSTR(Strng$,"[")   ' highlight default
  2103.       IF WasX > 0 THEN _
  2104.          WasY = INSTR(WasX,Strng$,"]") : _
  2105.          IF WasY > 0 THEN _
  2106.             CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$)
  2107.       IF AlreadyColorized THEN _
  2108.          EXIT SUB
  2109.       WasX = INSTR(Strng$,"<")
  2110.       IF WasX < 1 THEN _
  2111.          GOTO 59945
  2112. 59943 WasY = INSTR(WasX,Strng$,">")
  2113.       IF WasY < 1 THEN _
  2114.          GOTO 59945
  2115.       CALL Bracket (Strng$,WasX,WasY,ZFG4$,ZEmphasizeOff$)
  2116.       WasY = INSTR(Strng$," ")
  2117.       IF WasY > 1 AND WasY < WasX THEN _
  2118.          Strng$ = ZFG1$ + Strng$ : _
  2119.          WasZ = INSTR(WasY+1,Strng$," ") : _
  2120.          IF WasZ > 1 AND WasZ < WasX+LEN(ZFG1$) THEN _
  2121.             Strng$ = LEFT$(Strng$,WasZ) + ZFG2Def$ + MID$(Strng$,WasZ+1)
  2122.       EXIT SUB
  2123. 59945 WasX = 1
  2124.       DidInsert = ZFalse
  2125.       WasL = LEN(ZFG4$)
  2126. 59950 WasY = INSTR (WasX,Strng$,")")  ' x: where command begins, y: terminating pos
  2127.       WasZ = INSTR (WasX,Strng$,",")
  2128.       IF WasY = 0 OR (WasZ > 0 AND WasZ < WasY) THEN _
  2129.          WasY = WasZ
  2130.       WasK = LEN(Strng$)
  2131.       IF WasX > WasK THEN _
  2132.          EXIT SUB
  2133.       IF WasY < 1 THEN _
  2134.          IF NOT DidInsert THEN _
  2135.             EXIT SUB _
  2136.          ELSE WasY = WasK+1
  2137.       WasZ = WasY - 1
  2138.       WHILE WasZ > 0    ' got terminating pos: find beginning
  2139.          IF INSTR(ZOptionEnd$,MID$(Strng$,WasZ,1)) > 0 THEN _
  2140.             WasX = WasZ + 1 : _
  2141.             WasZ = 0
  2142.          WasZ = WasZ - 1
  2143.       WEND
  2144.       IF WasY-WasX < 3 THEN _     ' exclude commands too long
  2145.          CmndString$ = MID$(Strng$,WasX,WasY-WasX) : _
  2146.          WasX$ = CmndString$ : _
  2147.          CALL AllCaps (CmndString$) : _
  2148.          IF WasX$ = CmndString$ THEN _  ' exclude lower case
  2149.             DidInsert = ZTrue : _
  2150.             CALL Bracket (Strng$,WasX,WasY-1,ZFG4$,ZEmphasizeOff$) : _  ' colorize
  2151.             WasY = WasY + WasL
  2152.       WasX = WasY + 1
  2153.       GOTO 59950
  2154.       END SUB
  2155. 59960 ' $SUBTITLE: 'Bracket - Inserts strings around a string'
  2156. ' $PAGE
  2157. '
  2158. '  NAME    --  Bracket
  2159. '
  2160. '  INPUTS  --  PARAMETER                   MEANING
  2161. '              Strng$              Insert in this string
  2162. '              B4Here              Insert 1st before this pos
  2163. '              AfterHere           Insert 2nd after this pos
  2164. '              B4String$           String to insert before
  2165. '              AfterString$        String to insert after
  2166. '
  2167. '  OUTPUTS --  Strng$
  2168. '
  2169. '  PURPOSE -- Primarily for colorization
  2170. '
  2171.       SUB Bracket (Strng$,B4Here,AfterHere,B4String$,AfterString$) STATIC
  2172.       Strng$ = LEFT$(Strng$,B4Here-1) + _
  2173.                B4String$ + _
  2174.                MID$(Strng$,B4Here,AfterHere-B4Here+1) + _
  2175.                AfterString$ + _
  2176.                RIGHT$(Strng$,LEN(Strng$) - AfterHere)
  2177.       END SUB
  2178. 59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text'
  2179. ' $PAGE
  2180. '
  2181. '  NAME    --  UserColor
  2182. '
  2183. '  INPUTS  --  PARAMETER                   MEANING
  2184. '              ZEmphasizeOff$            Normal text color
  2185. '
  2186. '  OUTPUTS --  ZEmphasizeOff$            New text color
  2187. '              ZBoldText$                Whether bold (0 not, 1 bold)
  2188. '              ZUserTextColor            ANSI Color selected
  2189. '
  2190. '  PURPOSE --  Lets caller select desired color and whether bold.
  2191. '
  2192.       SUB UserColor STATIC
  2193.       IF ZHiLiteOff THEN _
  2194.          EXIT SUB
  2195. 59970 CALL QuickTPut (ZEmphasizeOff$,0)
  2196.       ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$
  2197.       GOSUB 59973
  2198.       IF ZWasQ = 0 THEN _
  2199.          ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
  2200.              ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
  2201.          EXIT SUB
  2202.       CALL AllCaps (ZUserIn$)
  2203.       WasX = INSTR("RGYBPCW",ZUserIn$)
  2204.       IF WasX = 0 THEN _
  2205.          GOTO 59970
  2206.       ZUserTextColor = 30 + WasX
  2207.       ZOutTxt$ = "Make text BOLD (Y,[N])"
  2208.       GOSUB 59973
  2209.       ZBoldText$ = CHR$(48 - ZYes)
  2210.       ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
  2211.       GOTO 59970
  2212. 59973 ZSubParm = 1
  2213.       ZTurboKey = -ZTurboKeyUser
  2214.       CALL TGet
  2215.       IF ZSubParm = -1 THEN _
  2216.          EXIT SUB
  2217.       RETURN
  2218.       END SUB
  2219. 59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference'
  2220. ' $PAGE
  2221. '
  2222. '  NAME    --  SetGraphic
  2223. '
  2224. '  INPUTS  --  PARAMETER                   MEANING
  2225. '              GraphicsNumber        0=None, 1=Ascii, 2=color
  2226. '
  2227. '  OUTPUTS --  ZWasGR                Shared var - set to
  2228. '                                    graphics.number
  2229. '              GraphicsLetter$       What add to file name to
  2230. '                                see if got graphics file ver
  2231. '
  2232. '  PURPOSE --  Sets file graphics preference
  2233. '
  2234.       SUB SetGraphic (GraphicsNumber,GraphicsLetter$) STATIC
  2235.       ZWasGR = GraphicsNumber
  2236.       IF ZWasGR = 2 THEN _
  2237.          ZDR1$ = ZFG1Def$ : _
  2238.          ZDR2$ = ZFG2Def$ : _
  2239.          ZDR3$ = ZFG3Def$ : _
  2240.          ZDR4$ = ZFG4Def$ _
  2241.       ELSE ZDR1$ = "" : _
  2242.            ZDR2$ = "" : _
  2243.            ZDR3$ = "" : _
  2244.            ZDR4$ = ""
  2245.       GraphicsLetter$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0))
  2246.       END SUB
  2247. 60000 ' $SUBTITLE: 'EofComm - Determines whether input in comm port buffer'
  2248. ' $PAGE
  2249. '
  2250. '  NAME    --  EofComm
  2251. '
  2252. '  INPUTS  --  PARAMETER                   MEANING
  2253. '               ZFossil              Whether fossil driver used
  2254. '               ZComPort            Comm port # in use
  2255. '
  2256. '  OUTPUTS --  NoChars           -1 (True) if no chars in buffer.
  2257. '                                   Anything else means has char.
  2258. '
  2259. '  PURPOSE -- Query comm port to see if input waiting
  2260. '
  2261.       SUB EofComm (NoChars) STATIC
  2262.       IF ZFossil THEN _
  2263.          CALL FosReadAhead(ZComPort,NoChars) _
  2264.       ELSE NoChars = EOF(3)
  2265.       END SUB
  2266. 60100 ' $SUBTITLE: 'GlobalSrchRepl - Global search and replace'
  2267. ' $PAGE
  2268. '
  2269. '  NAME    --  GlobalSrchRepl
  2270. '
  2271. '  INPUTS  --  PARAMETER                   MEANING
  2272. '              Strng$              String to edit
  2273. '              LookFor$           String to look for
  2274. '              ReplaceBy$         String to replace by
  2275. '
  2276. '  OUTPUTS --  Strng$              Edited string
  2277. '
  2278. '  PURPOSE --  Replaces every occurence of LookFor$ that
  2279. '                         is in Strng$ by ReplaceBy$
  2280. '
  2281.       SUB GlobalSrchRepl (Strng$,LookFor$,ReplaceBy$,OverStrike) STATIC
  2282.       IF LookFor$ = "" THEN _
  2283.          EXIT SUB
  2284.       WasX = 1
  2285.       WasL = LEN(ReplaceBy$)
  2286.       ZMsgPtr = LEN(LookFor$)
  2287. 60102 WasY = INSTR(WasX,Strng$,LookFor$)
  2288.       IF WasY < 1 THEN _
  2289.          EXIT SUB
  2290.       IF OverStrike THEN _
  2291.          MID$(Strng$,WasY) = ReplaceBy$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2292.       ELSE Strng$ = LEFT$(Strng$,WasY-1) + _
  2293.                     ReplaceBy$ + _
  2294.                     RIGHT$(Strng$,LEN(Strng$)-WasY+1-ZMsgPtr)
  2295.       WasX = WasY + WasL
  2296.       IF WasX > LEN(Strng$) THEN _
  2297.          EXIT SUB
  2298.       GOTO 60102
  2299.       END SUB
  2300. 60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace'
  2301. ' $PAGE
  2302. '
  2303. '  NAME    --  MetaGSR
  2304. '
  2305. '  INPUTS  --  PARAMETER               MEANING
  2306. '              Strng$              String to edit
  2307. '
  2308. '  OUTPUTS --  Strng$              Edited string
  2309. '
  2310. '  PURPOSE --  Global search and replace for meta variables
  2311. '
  2312.       SUB MetaGSR (Strng$,OverStrike) STATIC
  2313.       WasY = 1
  2314. 60131 IF WasY > LEN(Strng$) THEN _
  2315.          EXIT SUB
  2316.       WasX = INSTR(WasY,Strng$,"[")
  2317.       IF WasX = 0 THEN _
  2318.          EXIT SUB
  2319.       WasY = INSTR(WasX,Strng$,"]")
  2320.       IF WasY = 0 THEN _
  2321.          EXIT SUB
  2322.       ZMsgPtr = WasY-WasX+1
  2323.       Temp = WasY-WasX-1
  2324.       CALL CheckInt(MID$(Strng$,WasX+1,Temp))
  2325.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR (ZTestedIntValue > ZMaxWorkVar) THEN _
  2326.          GOTO 60135
  2327.       IF ((ZTestedIntValue < 10) AND (Temp = 1)) OR ((ZTestedIntValue > 9) AND (Temp = 2)) THEN _
  2328.          GOTO 60132
  2329.       WasY = WasX + 1
  2330.       GOTO 60131
  2331. 60132 WorkHold$ = ZGSRAra$(ZTestedIntValue)
  2332.       IF WasY = LEN(Strng$) THEN _
  2333.          GOTO 60151
  2334.       IF MID$(Strng$,WasY+1,1) <> "(" THEN _
  2335.          GOTO 60151
  2336.       WasI = INSTR(WasY+1,Strng$,")")
  2337.       IF WasI = 0 THEN _
  2338.          GOTO 60151
  2339.       WasJ = INSTR(WasY+1,Strng$,":")
  2340.       IF WasJ > WasI THEN _
  2341.          GOTO 60151
  2342.       CALL CheckInt (MID$(Strng$,WasY+2))
  2343.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  2344.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2345.             GOTO 60151
  2346.       WasY = WasI
  2347.       ZMsgPtr = WasI-WasX+1
  2348.       StartSub = ZTestedIntValue
  2349.       CALL CheckInt (MID$(Strng$,WasJ+1))
  2350.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR _
  2351.          (ZTestedIntValue > LEN(WorkHold$)) THEN _
  2352.             GOTO 60151
  2353.       LenSub = ZTestedIntValue
  2354.       WorkHold$ = MID$(WorkHold$,StartSub,LenSub)
  2355.       GOTO 60151
  2356. 60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1)
  2357.       WasI = INSTR("      BAUD  PORT  PORT# PARITYPROTO NODE  FILE  ",MetaVal$)
  2358.       IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _
  2359.          WasY = WasX + 1 : _
  2360.          GOTO 60131
  2361.       WasJ = (WasI-1)\6 + 1
  2362.       WasK = (WasI+4)\6 + 1
  2363.       IF WasK > WasJ THEN _
  2364.          EXIT SUB
  2365.       ON WasJ GOTO 60155, _
  2366.                 60137, _
  2367.                 60139, _
  2368.                 60141, _
  2369.                 60143, _
  2370.                 60145, _
  2371.                 60147, _
  2372.                 60149, _
  2373.                 60151
  2374. 60137 WorkHold$ = ZTalkToModemAt$
  2375.       GOTO 60151
  2376. 60139 WorkHold$ = ZComPort$
  2377.       GOTO 60151
  2378. 60141 WorkHold$ = MID$(ZComPort$,4)
  2379.       GOTO 60151
  2380. 60143 WorkHold$ = MID$(ZBaudParity$,INSTR(ZBaudParity$,",")+1,1)
  2381.       GOTO 60151
  2382. 60145 WorkHold$ = ZWasFT$
  2383.       GOTO 60151
  2384. 60147 WorkHold$ = ZNodeID$
  2385.       GOTO 60151
  2386. 60149 IF ZBatchTransfer THEN _
  2387.          WorkHold$ = "@" + ZNodeWorkFile$ _
  2388.       ELSE WorkHold$ = ZFileName$
  2389.       GOTO 60151
  2390. 60151 WasL = LEN(WorkHold$)
  2391.       IF OverStrike THEN _
  2392.          MID$(Strng$,WasX) = WorkHold$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
  2393.       ELSE Strng$ = LEFT$(Strng$,WasX-1) + WorkHold$ + RIGHT$(Strng$,LEN(Strng$)-WasY)
  2394.       WasY = 1 ' WasY = WasX + WasL
  2395.       GOTO 60131
  2396. 60155 WasY = WasY + 1
  2397.       GOTO 60131
  2398.       END SUB
  2399. 60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
  2400. ' $PAGE
  2401. '
  2402. '  NAME    --  TimeLock  (written by Doug Azzarito)
  2403. '
  2404. '  INPUTS  --  PARAMETER                   MEANING
  2405. '              ZTimeLockSet               SECONDS/SESSION TO LOCK
  2406. '
  2407. '  OUTPUTS --  ZSubParm     -1 if feature is LOCKED
  2408. '
  2409. '  PURPOSE -- Check elapsed time for lock duration
  2410. '
  2411.       SUB TimeLock STATIC
  2412.       CALL TimeRemain(MinsRemaining)
  2413.       IF ZSecsUsedSession! >= ZTimeLockSet THEN _
  2414.          ZOK = ZTrue : _
  2415.          EXIT SUB
  2416.       ZOutTxt$ = ZFirstName$
  2417.       CALL NameCaps(ZOutTxt$)
  2418.       CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _
  2419.                    STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _' DA11102
  2420.                    " more minutes" + _
  2421.                    STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds")
  2422.       CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
  2423.       ZOK = ZFalse
  2424.       END SUB
  2425. 60200 ' $SUBTITLE: 'MarkTime - Give feedback for lengthy processes'
  2426. ' $PAGE
  2427. '
  2428. '  NAME    --  MarkTime
  2429. '
  2430. '  INPUTS  --  PARAMETER                   MEANING
  2431. '              DotNumber          How many dots printed
  2432. '
  2433. '  OUTPUTS --  DotNumber
  2434. '
  2435. '  PURPOSE --  Marks time by putting colorized dots out
  2436. '              to 4, then erasing
  2437. '
  2438.       SUB MarkTime (DotNumber) STATIC
  2439.       TimeNow! = TIMER
  2440.       IF TimeNow! - PrevTI! < 1.0 THEN _
  2441.          EXIT SUB
  2442.       PrevTI! = TimeNow!
  2443.       IF RemoveDot AND DotNumber > 0 THEN _
  2444.          CALL QuickTPut (ZBackSpace$,0) : _
  2445.          DotNumber = DotNumber - 1 : _
  2446.          EXIT SUB
  2447.       DotNumber = DotNumber + 1
  2448.       ON DotNumber GOTO 60201,60202,60203,60204
  2449. 60201 WasX$ = ZFG1$
  2450.       RemoveDot = ZFalse
  2451.       GOTO 60205
  2452. 60202 WasX$ = ZFG2$
  2453.       GOTO 60205
  2454. 60203 WasX$ = ZFG3$
  2455.       GOTO 60205
  2456. 60204 WasX$ = ZFG4$
  2457.       RemoveDot = ZTrue
  2458. 60205 CALL QuickTPut (WasX$ + "." + ZEmphasizeOff$,0)
  2459.       END SUB
  2460. 60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
  2461. ' $PAGE
  2462. '
  2463. '  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
  2464. '                        'and RoseMarie Siddiqui
  2465. '
  2466. '  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
  2467. '                                       notification and how
  2468. '
  2469. '  OUTPUTS -- NONE
  2470. '
  2471. '  PURPOSE -- Search ZAutoPageDef$ for match on whether
  2472. '             on name, security level, whether new user.
  2473. '             Also controls whether caller notified and
  2474. '             number of times sysop has bell rung.
  2475. '             And what tune to play (if any).
  2476. '
  2477.       SUB AutoPage STATIC
  2478.       CALL FindIt (ZAutoPageDef$)
  2479.       IF NOT ZOK THEN _
  2480.          EXIT SUB
  2481.       ZErrCode = 0
  2482.       ZOK = ZFalse
  2483.       WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
  2484.          CALL ReadParms (ZWorkAra$(),4,1)
  2485.          IF ZErrCode = 0 THEN _
  2486.             ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
  2487.             IF NOT ZOK THEN _
  2488.                IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
  2489.                   ZOK = ZTrue _
  2490.                ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
  2491.                        ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
  2492.                        IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
  2493.                           IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
  2494.                              ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
  2495.                                 ZOK = ZTrue
  2496.       WEND
  2497.       CLOSE 2
  2498.       IF ZErrCode > 0 OR NOT ZOK THEN _
  2499.          ZErrCode = 0 : _
  2500.          EXIT SUB
  2501.       ZPageStatus$ = "AutoPaged!"
  2502.       IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
  2503.          ZOutTxt$ = "Telling sysop you're on..." : _
  2504.          CALL RingCaller
  2505.       ZWasB = (ZWorkAra$(4) = "")
  2506.       ZWorkAra$(5) = ""
  2507.       FOR WasI = 1 TO VAL(ZWorkAra$(3))
  2508.          IF ZWasB THEN _
  2509.             CALL LPrnt (ZBellRinger$,0) : _
  2510.          ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
  2511.       NEXT
  2512.       IF NOT ZWasB THEN _
  2513.          CALL RBBSPlay (ZWorkAra$(5))
  2514.       END SUB
  2515. 62520 ' $SUBTITLE: 'PutMsgAttr - subroutine to save msg. attributes'
  2516. ' $PAGE
  2517. '
  2518. '  NAME    --  PutMsgAttr
  2519. '
  2520. '  INPUTS  --  PARAMETER                   MEANING
  2521. '              ZWasQ
  2522. '              ZUserIn$
  2523. '              ZLinesInMsg
  2524. '              ZWasS
  2525. '              ZNonStop
  2526. '              ZMsgDimIndex
  2527. '
  2528. '  OUTPUTS --  ZWasSQ
  2529. '              ZWasLG$(10)
  2530. '              ZLinesInMsgSave
  2531. '              ZWasSL
  2532. '              ZNonStopSave
  2533. '              ZMsgDimIndexSave
  2534. '
  2535. '  PURPOSE --  WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES
  2536. '              THE ATTRIBUTES OF THE ORGINAL MESSAGE
  2537. '
  2538.       SUB PutMsgAttr STATIC
  2539.       ZWasSQ = ZWasQ
  2540.       ZWasLG$(10) = ZUserIn$
  2541.       ZLinesInMsgSave = ZLinesInMsg
  2542.       ZWasSL = ZWasS
  2543.       ZNonStopSave = ZNonStop
  2544.       ZMsgDimIndexSave = ZMsgDimIndex
  2545.       END SUB
  2546. 62530 ' $SUBTITLE: 'GetMsgAttr - subroutine to get msg. attributes'
  2547. ' $PAGE
  2548. '
  2549. '  NAME    --  GetMsgAttr
  2550. '
  2551. '  INPUTS  --  PARAMETER                   MEANING
  2552. '              ZWasSQ
  2553. '              ZWasLG$(10)
  2554. '              ZLinesInMsgSave
  2555. '              ZWasSL
  2556. '              ZNonStopSave
  2557. '              ZMsgDimIndexSave
  2558. '
  2559. '  OUTPUTS --  ZWasQ
  2560. '              ZUserIn$
  2561. '              LINES.IN.MESSAGESAVE
  2562. '              ZWasS
  2563. '              ZNonStop
  2564. '              ZMsgDimIndex
  2565. '              ZKillMessage
  2566. '
  2567. '  PURPOSE --  After replying to a message this routine restores
  2568. '              the attributes of the orginal message
  2569. '
  2570.       SUB GetMsgAttr STATIC
  2571.       ZWasQ = ZWasSQ
  2572.       ZUserIn$ = ZWasLG$(10)
  2573.       ZLinesInMsg = ZLinesInMsgSave
  2574.       ZWasS = ZWasSL
  2575.       ZNonStop = ZNonStopSave
  2576.       ZMsgDimIndex = ZMsgDimIndexSave
  2577.       ZKillMessage = ZFalse
  2578.       END SUB
  2579. 62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
  2580. ' $PAGE
  2581. '
  2582. '  NAME    --  RptTime
  2583. '
  2584. '  INPUTS  --  PARAMETER                   MEANING
  2585. '
  2586. '  OUTPUTS --
  2587. '
  2588. '  PURPOSE --  Tells user time used on system
  2589. '
  2590.       SUB RptTime STATIC
  2591.       CALL SkipLine (1)
  2592.       CALL GetTime
  2593.       CALL AMorPM
  2594.       Mins = (ZSessionHour * 60) + ZSessionMin
  2595.       CALL Carrier
  2596.       IF ZSubParm = -1 THEN _
  2597.          EXIT SUB
  2598.       CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$)
  2599.       CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _
  2600.                         STR$(ZSessionSec) + " secs")
  2601.       CALL Talk (7,ZOutTxt$)
  2602.       END SUB
  2603. 62600 ' $SUBTITLE: 'Protocol - Determine protocols available'
  2604. ' $PAGE
  2605. '
  2606. '  NAME    -- Protocol
  2607. '
  2608. '  INPUTS  --     PARAMETER                    MEANING
  2609. '                 ZProtoDef$                File of installed protocols
  2610. '
  2611. '  OUTPUTS -- ZTransferOption$         Prompt for protocol choice
  2612. '             ZDefaultXfer$            Letters of protocols
  2613. '             ZInternalEquiv$          Internal protocol to use
  2614. '
  2615. '  PURPOSE -- TO determine what protocols are available to user
  2616. '
  2617.       SUB Protocol STATIC
  2618.       CALL FindIt (ZProtoDef$)
  2619.       IF NOT ZOK THEN _
  2620.          ZTransferOption$ = "A)scii,X)modem,C)rcXmodem,Y)modem" : _
  2621.          ZInternalEquiv$ = "AXCY" : _
  2622.          ZDefaultXfer$ = "AXCY" : _
  2623.          GOTO 62604
  2624.       ZDefaultXfer$ = ""
  2625.       ZInternalEquiv$ = ""
  2626.       ZTransferOption$ = ""
  2627.       WasL = 0
  2628. 62602 IF EOF(2) THEN _
  2629.          GOTO 62604
  2630.       CALL ReadParms (ZWorkAra$(),13,1)
  2631.       IF ZErrCode > 0 THEN _
  2632.          EXIT SUB
  2633.       ZDefaultXfer$ = ZDefaultXfer$ + " "
  2634.       ZInternalEquiv$ = ZInternalEquiv$ + " "
  2635.       IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  2636.          GOTO 62602
  2637.       IF LEFT$(ZWorkAra$(5),1) = "R" THEN _
  2638.          IF NOT ZReliableMode THEN _
  2639.             GOTO 62602
  2640.       IF LEFT$(ZWorkAra$(3),1) = "I" THEN _
  2641.          GOTO 62603
  2642.       WasX = INSTR(ZWorkAra$(12)+" "," ")
  2643.       WasX$ = LEFT$(ZWorkAra$(12),WasX-1)
  2644.       CALL FindFile (WasX$,Found)
  2645.       IF Found THEN _
  2646.          WasX = INSTR(ZWorkAra$(13)+" "," ") : _
  2647.          WasX$ = LEFT$(ZWorkAra$(13),WasX-1) : _
  2648.          CALL FindFile (WasX$,Found)
  2649.       IF NOT Found THEN _
  2650.          GOTO 62602
  2651. 62603 MID$(ZDefaultXfer$,LEN(ZDefaultXfer$),1) = LEFT$(ZWorkAra$(1),1)
  2652.       CALL FindLast (ZWorkAra$(1),ZCrLf$,WasX,WasI)
  2653.       IF WasX > 0 AND WasX >= LEN(ZWorkAra$(1)) - 2 THEN _
  2654.          ZWorkAra$(1) = LEFT$(ZWorkAra$(1),WasX-1)
  2655.       IF (WasL + LEN(ZWorkAra$(1)) < 62) AND WasX = 0 THEN _
  2656.          ZTransferOption$ = ZTransferOption$ + "," + ZWorkAra$(1) : _
  2657.          WasL = WasL + LEN(ZWorkAra$(1)) + 1 _
  2658.       ELSE WasL = LEN(ZWorkAra$(1)) : _
  2659.            ZTransferOption$ = ZTransferOption$ + _
  2660.                               ZCrLf$ + _
  2661.                               ZWorkAra$(1)
  2662.       IF LEFT$(ZWorkAra$(3),1) = "I" AND RIGHT$(ZWorkAra$(3),1) <> "I" THEN _
  2663.          MID$(ZInternalEquiv$,LEN(ZInternalEquiv$),1) = RIGHT$(ZWorkAra$(3),1)
  2664.       GOTO 62602
  2665. 62604 IF INSTR(ZInternalEquiv$,"N") > 0 THEN _
  2666.          GOTO 62605
  2667.       IF WasX = 0 THEN _
  2668.          ZTransferOption$ = ZTransferOption$ + ",N)one" _
  2669.       ELSE ZTransferOption$ = ZTransferOption$ + ZCrLf$ + "N)one"
  2670.       ZDefaultXfer$ = ZDefaultXfer$ + "N"
  2671.       ZInternalEquiv$ = ZInternalEquiv$ + "N"
  2672. 62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
  2673.          ZTransferOption$ = MID$(ZTransferOption$,2)
  2674.       IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
  2675.          CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+" unavailable.  Default reset to None") : _
  2676.          ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
  2677.       END SUB
  2678. 62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
  2679. ' $PAGE
  2680. '
  2681. '  NAME    -- Transfer
  2682. '
  2683. '  INPUTS  --     PARAMETER                    MEANING
  2684. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2685. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2686. '              ZFileName$                NAME OF FILE FOR Transfer
  2687. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2688. '                                        TO BE USED BY KERMIT (COM1
  2689. '                                        OR COM2)
  2690. '              ZBPS                      = -1 FOR   300 BAUD
  2691. '                                        = -2 FOR   450 BAUD
  2692. '                                        = -3 FOR  1200 BAUD
  2693. '                                        = -4 FOR  2400 BAUD
  2694. '                                        = -5 FOR  4800 BAUD
  2695. '                                        = -6 FOR  9600 BAUD
  2696. '                                        = -7 FOR 19200 BAUD
  2697. '
  2698. '  OUTPUTS  -- NONE
  2699. '
  2700. '  PURPOSE -- To transfer files using external protocols
  2701. '
  2702.       SUB Transfer STATIC
  2703.       IF ZPrivateDoor THEN _
  2704.          CALL PrivDoorRtn : _
  2705.          EXIT SUB
  2706.       IF ZTransferFunction = 1 THEN _
  2707.          ZUserIn$ = ZDownTemplate$ : _
  2708.          ZWasZ$ = "send " _
  2709.       ELSE IF ZTransferFunction = 2 THEN _
  2710.               ZUserIn$ = ZUpTemplate$ : _
  2711.               ZWasZ$ = "receive "
  2712.       CALL MetaGSR (ZUserIn$,ZFalse)
  2713.       CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
  2714.       CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0)
  2715.       IF ZBatchTransfer THEN _
  2716.          CALL QuickTPut1 ("(BATCH)") : _
  2717.          CALL OpenWork (2,ZNodeWorkFile$) : _
  2718.          WHILE NOT EOF(2) : _
  2719.            CALL ReadAny : _
  2720.            CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
  2721.            CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
  2722.          WEND _
  2723.       ELSE CALL QuickTPut1 (ZFileNameHold$)
  2724.       IF ZAutoLogoffReq THEN _
  2725.          CALL QuickTPut1 ("Automatic logoff, if download successful")
  2726.       CALL PrivDoorRtn
  2727.       END SUB
  2728. 62624 ' $SUBTITLE: 'PrivDoorRtn - subroutine to exit as a private door.'
  2729. ' $PAGE
  2730. '
  2731. '  NAME    -- PrivDoorRtn
  2732. '
  2733. '  INPUTS  --     PARAMETER                    MEANING
  2734. '              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
  2735. '                                        = 2 UPLOAD FILE TO RBBS-PC
  2736. '                                        = 3 USER REGISTRATION PGM
  2737. '              ZUserIn$                      NAME OF FILE TO EXIT TO
  2738. '              ZComPort$                 NAME OF COMMUNICATIONS PORT
  2739. '                                        TO BE USED BY KERMIT (COM1
  2740. '                                        OR COM2)
  2741. '              ZBPS                      = -1 FOR   300 BAUD
  2742. '                                        = -2 FOR   450 BAUD
  2743. '                                        = -3 FOR  1200 BAUD
  2744. '                                        = -4 FOR  2400 BAUD
  2745. '                                        = -5 FOR  4800 BAUD
  2746. '                                        = -6 FOR  9600 BAUD
  2747. '                                        = -7 FOR 19200 BAUD
  2748. '
  2749. '  OUTPUTS -- NONE
  2750. '
  2751. '  PURPOSE -- To transfer control to another program
  2752. '
  2753.       SUB PrivDoorRtn STATIC
  2754.       IF ZPrivateDoor THEN _
  2755.          GOTO 62630
  2756.       IF ZFakeXRpt THEN _
  2757.          CALL FakeXRpt (ZWasFT$)
  2758.       IF ZAdvanceProtoWrite THEN _
  2759.          CALL OpenOutW ("XFER-"+ZNodeID$+".DEF") : _
  2760.          IF ZErrCode < 1 THEN _
  2761.             CALL PrintWorkA (ZFileName$+",,"+ZWasFT$) : _
  2762.             CLOSE 2
  2763.       IF ZProtoMethod$ = "S" THEN _
  2764.          GOTO 62629
  2765. 62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
  2766.       IF WasX$ = "" THEN _
  2767.          EXIT SUB
  2768.       CALL FindIt (WasX$)
  2769.       IF NOT ZOK THEN _
  2770.          ZOutTxt$ = "Missing door program" : _
  2771.          CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
  2772.          ZSnoop = ZTrue : _
  2773.          CALL LPrnt (ZOutTxt$,1) : _
  2774.          EXIT SUB
  2775.       ZOutTxt$(1) = "CLS"
  2776.       GOSUB 62633
  2777.       ZOutTxt$(2) = "ECHO" + ZOutTxt$
  2778.       ZOutTxt$(3) = ZDiskForDos$ + _
  2779.               "COMMAND /C " + _
  2780.               ZUserIn$
  2781.       ZOutTxt$(4) = ZRBBSBat$
  2782.       ZPrivateDoor = ZTrue
  2783.       CALL QuickTPut1 ("Exiting to External Pgm for Transfer")
  2784.       LOCATE 25,1
  2785.       CALL LPrnt(ZLineFeed$,0)
  2786.       CALL RBBSExit (ZOutTxt$(),4)
  2787. 62629 GOSUB 62633
  2788.       CLS
  2789.       CALL LPrnt (ZOutTxt$,1)
  2790.       CALL ShellExit (ZUserIn$)
  2791. 62630 IF ZPrivateDoor THEN _
  2792.          CALL RestoreCom : _
  2793.          CALL DelayTime (7 + ZBPS) : _
  2794.          CALL SetBaud : _
  2795.          CALL QuickTPut1 ("Reloading RBBS-PC.  Please be patient.")
  2796. 62631 CALL SkipLine (2)
  2797.       LOCATE 24,1
  2798. 62632 EXIT SUB
  2799. 62633 ZOutTxt$ = STR$(ZUserSecLevel) + _
  2800.                  " " + _
  2801.                  ZActiveUserName$ + _
  2802.                  " " + _
  2803.                  ZWasCI$
  2804.       RETURN
  2805.       END SUB
  2806. 62650 ' $SUBTITLE: 'FakeXRpt - subroutine to create fake xfer report'
  2807. ' $PAGE
  2808. '
  2809. '  NAME    --  FakeXRpt
  2810. '
  2811. '  INPUTS  --  PARAMETER                   MEANING
  2812. '              ZFileNameHold$      FILE TO BE TRANSFERRED
  2813. '              ProtoUsed$          Protocol USED
  2814. '
  2815. '  OUTPUTS --  WRITES OUT Transfer FILE REPORT
  2816. '
  2817. '  PURPOSE --  External protocol drivers that do not write
  2818. '              out a standard transfer report must have one
  2819. '              provided in order for "dooring" to external
  2820. '              protocols to work properly, since this file
  2821. '              is read upon returning from an external protocol.
  2822. '
  2823.       SUB FakeXRpt (ProtoUsed$) STATIC
  2824.       CLOSE 2
  2825.       OPEN "O",2,"XFER-" + _
  2826.                  ZNodeFileID$ + _
  2827.                  ".DEF"
  2828.       PRINT #2,ZFileName$
  2829.       PRINT #2,
  2830.       PRINT #2,ProtoUsed$
  2831.       PRINT #2,"S"
  2832.       CLOSE 2
  2833.       END SUB
  2834. 62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change'
  2835. ' $PAGE
  2836. '
  2837. '  NAME    --  SetExpert
  2838. '
  2839. '  INPUTS  --  PARAMETER                   MEANING
  2840. '              ZExpertUser          WHETHER IS AN EXPERT
  2841. '
  2842. '  OUTPUTS --  ZMorePrompt$         Pause prompt
  2843. '              ZPressEnter$         Prompt to press enter
  2844. '
  2845. '  PURPOSE --  Make more helpful prompt for novices and shorter
  2846. '              one for experts
  2847. '
  2848.       SUB SetExpert STATIC
  2849.       IF ZExpertUser THEN _
  2850.          ZMorePrompt$ = "More <[Y],N,C,A" : _
  2851.          ZPressEnter$ = ZPressEnterExpert$ : _
  2852.          EXIT SUB
  2853.       ZMorePrompt$ = "More [Y]es,N)o,C)ont,A)bort"
  2854.       ZPressEnter$ = ZPressEnterNovice$
  2855.       END SUB
  2856. 62668 ' $SUBTITLE: 'NewPassword - subroutine to get new password'
  2857. ' $PAGE
  2858. '
  2859. '  NAME    --  NewPassword
  2860. '
  2861. '  INPUTS  --  PARAMETER                   MEANING
  2862. '              Prompt$               Prompt to display
  2863. '              DisallowSpaces        Whether answer can have all spaces
  2864. '
  2865. '  OUTPUTS --  ZWasZ$                   Password
  2866. '
  2867. '  PURPOSE --  To get a new password.
  2868. '
  2869.       SUB NewPassword (Prompt$,DisallowSpaces) STATIC
  2870. 62670 ZOutTxt$ = Prompt$
  2871.       ZHidden = ZTrue
  2872.       CALL PopCmdStack
  2873.       ZHidden = ZFalse
  2874.       IF ZSubParm < 0 OR ZWasQ = 0 THEN _
  2875.          EXIT SUB
  2876.       IF LEN(ZUserIn$) > 15 THEN _
  2877.          CALL QuickTPut1 ("15 chars max") : _
  2878.          GOTO 62670
  2879.       IF INSTR(ZUserIn$,";") > 0 THEN _
  2880.          CALL QuickTPut1 ("Cannot use ';'") : _
  2881.          GOTO 62670
  2882.       IF DisallowSpaces THEN _
  2883.          IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
  2884.             CALL QuickTPut1 ("Not all blanks") : _
  2885.             GOTO 62670
  2886.       CALL AllCaps (ZUserIn$)
  2887.       ZWasZ$ = ZUserIn$
  2888.       END SUB
  2889. 63000 ' $SUBTITLE: 'TimedOut - exits based on time of day'
  2890. ' $PAGE
  2891. '
  2892. '  NAME    --  TimedOut
  2893. '
  2894. '  INPUTS  --  PARAMETER                   MEANING
  2895. '              ZRCTTYBat$
  2896. '              ZNodeRecIndex
  2897. '              ZMsgRec$
  2898. '              ZModemInitBaud$
  2899. '              ZModemGoOffHookCmnd$
  2900. '
  2901. '  OUTPUTS --  NONE
  2902. '
  2903. '  PURPOSE --  When RBBS-PC is to exit to DOS at a specific time of
  2904. '              day, this routine writes out to the file specified
  2905. '              in "ZRCTTYBat$" the one-line entry:
  2906. '                          RBBSxTM.BAT
  2907. '               WHERE "x" is the node id.
  2908. '
  2909.       SUB TimedOut STATIC
  2910.       FIELD #1,128 AS ZMsgRec$
  2911.       ZSubParm = 3
  2912.       CALL FileLock
  2913.       GET 1,ZNodeRecIndex
  2914.       WasX$ = DATE$
  2915.       CALL PackDate (WasX$,ZWasY$)
  2916.       MID$(ZMsgRec$,77,2) = ZWasY$
  2917.       'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5)
  2918.       PUT 1,ZNodeRecIndex
  2919.       ZSubParm = 2
  2920.       CALL FileLock
  2921.       CLOSE 2
  2922.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF"
  2923.       OPEN "O",2,ZFileName$
  2924.       PRINT #2,MID$(ZFileName$,3,7)
  2925.       CLOSE 2
  2926.       IF ZLocalUserMode THEN _
  2927.          EXIT SUB
  2928.       IF ZSubParm <> 7 THEN _
  2929.          ZSubParm = 4 : _
  2930.          CALL FileLock : _
  2931.          CALL OpenCom(ZModemInitBaud$,",N,8,1")
  2932.       CALL TakeOffHook
  2933.       END SUB
  2934. 64003 ' $SUBTITLE: 'AskUsers - subroutine to get registration information'
  2935. ' $PAGE
  2936. '
  2937. '  NAME    --  AskUsers  (WRITTEN BY JON MARTIN)
  2938. '
  2939. '  INPUTS  --  PARAMETER                   MEANING
  2940. '              ZFileName$           NAME OF THE FILE CONTAINING THE
  2941. '                                   SCRIPT TO BE USED WHEN ASKING
  2942. '                                   THE USER QUESTIONS.
  2943. '              ZActiveUserName$     NAME OF THE CURRENT USER
  2944. '              ZUserSecLevel        USER'S SECURITY
  2945. '              ZUpperCase           SET IF USER NEEDS UPPERCASE
  2946. '
  2947. '  OUTPUTS --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
  2948. '              FILE NAME SPECIFIED AS THE First PARAMETER IN THE
  2949. '              First RECORD OF THE FILE CONTAINING THE SCRIPT TO
  2950. '              BE USED.
  2951. '              ZUserSecLevel  CAN BE RAISED OR LOWERED
  2952. '
  2953. '  PURPOSE --  Provides a sophisticated, script driven mechanism by
  2954. '              which a sysop can control the interaction with the
  2955. '              user.  Special function questionnaires include the
  2956. '              registration questionnaire and the epilog.
  2957. '
  2958.       SUB AskUsers STATIC
  2959.       ZQuestAborted = ZFalse
  2960.       ZQuestChainStarted = ZFalse
  2961.       REDIM ZOutTxt$(256)
  2962.       REDIM ZWorkAra$(ZMaxWorkVar),ZGSRAra$(ZMaxWorkVar)
  2963.       PrevAppend$ = ""
  2964. '
  2965. '
  2966. ' *  LOAD SCRIPT CONTAINING THE QUESTIONS INTO THE ZOutTxt$ DIMENSION  *
  2967. '
  2968. '
  2969. 64005 ZChatAvail = ZFalse
  2970.       QestChain = ZFalse
  2971.       LastQues = 0
  2972.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  2973.       IF NOT ZOK THEN _
  2974.          EXIT SUB
  2975.       CALL ReadParms (ZOutTxt$(),2,1)
  2976.       IF ZErrCode > 0 THEN _
  2977.          EXIT SUB
  2978.       PrevAppend$ = AppendFileName$
  2979.       AppendFileName$ = ZOutTxt$(1)
  2980.       MaxSecLevel = VAL(ZOutTxt$(2))
  2981.       WasX = INSTR(ZOutTxt$(2)," ")
  2982.       IF WasX > 0 THEN _
  2983.          IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
  2984.             CALL QuickTPut1 ("Higher security needed for questionnaire") : _
  2985.             EXIT SUB
  2986. '
  2987. '
  2988. ' *  THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
  2989. ' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
  2990. ' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
  2991. ' *   3.  THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
  2992. ' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
  2993. ' *      and requires security 5 or more to access
  2994.       ScriptIndex = 1
  2995.       ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
  2996.                          " " + _
  2997.                          DATE$ + _
  2998.                          " " + _
  2999.                          TIME$
  3000. 64010 IF EOF(2) OR ScriptIndex > 255 THEN _
  3001.          GOTO 64100
  3002.       ScriptIndex = ScriptIndex + 1
  3003.       LINE INPUT #2,ZOutTxt$(ScriptIndex)
  3004.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  3005.          CALL AllCaps (ZOutTxt$(ScriptIndex)) : _
  3006.          CALL Trim (ZOutTxt$(ScriptIndex))
  3007.       IF ZUpperCase THEN _
  3008.          CALL AllCaps (ZOutTxt$(ScriptIndex))
  3009.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "?" THEN _
  3010.          ScriptIndex = ScriptIndex + 1 : _
  3011.          ZOutTxt$(ScriptIndex) = "!"
  3012.       GOTO 64010
  3013. '
  3014. '
  3015. ' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:
  3016. ' *
  3017. ' * First COLUMN     MEANING
  3018. ' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO
  3019. ' *      !        THIS MEANS THIS IS AN ANSWER
  3020. ' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS
  3021. ' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER
  3022. ' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER
  3023. ' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA
  3024. ' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL
  3025. ' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL
  3026. ' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT
  3027. ' *      &        THIS MEANS TO CHAIN TO ANOTHER QUESTIONNAIRE
  3028. ' *      M        Execute specified macro
  3029. ' *      T        Turbo Key
  3030. ' *      <        Assign value to work variable
  3031. '
  3032. 64100 ScriptMax = ScriptIndex
  3033.       ScriptIndex = 1
  3034. 64110 CALL Carrier
  3035.       IF ZSubParm = -1 THEN _
  3036.          GOTO 64510
  3037.       ScriptIndex = ScriptIndex + 1
  3038.       IF ScriptIndex > ScriptMax THEN _
  3039.          GOTO 64400
  3040.       ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2)
  3041.       WasX = ZFalse
  3042.       IF LEFT$(ZOutTxt$,3) = "/FL" THEN _
  3043.          ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
  3044.          WasX = ZTrue
  3045.       CALL MetaGSR (ZOutTxt$,WasX)
  3046.       CALL SmartText (ZOutTxt$,ZFalse,WasX)
  3047.       WasX$ = ZOutTxt$
  3048.       ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _
  3049.          64111, _       ' catch invalid lines
  3050.          64110, _       ' : label
  3051.          64110, _       ' ! stored answer
  3052.          64420, _       ' @ abort
  3053.          64120, _       ' M macro execute
  3054.          64430, _       ' T turbo key
  3055.          64440, _       ' > goto label
  3056.          64190, _       ' < assign value
  3057.          64450, _       ' * display line
  3058.          64113, _       ' ? prompt for answer
  3059.          64114, _       ' = conditional branch
  3060.          64460, _       ' - decrease security level
  3061.          64465, _       ' + increase security level
  3062.          64470          ' & chain
  3063. 64111 ZOutTxt$ = "Invalid line.  Column 1 is <" + LEFT$(ZOutTxt$(ScriptIndex),1)+">.  Must be: * ? = + - > @ & M T <"
  3064.       ZSubParm = 5
  3065.       CALL TPut
  3066.       GOTO 64510
  3067. 64113 LastQues = ScriptIndex  ' process ?
  3068.       GOSUB 64180
  3069.       ZSubParm = 1
  3070.       CALL TGet
  3071.       IF ZSubParm = -1 THEN _
  3072.          GOTO 64510 _
  3073.       ELSE IF ZWasQ = 0 THEN _
  3074.               ZOutTxt$ = WasX$ : _
  3075.               GOTO 64113 _
  3076.            ELSE ZOutTxt$(ScriptIndex + 1) = "!" + _
  3077.                                        ZUserIn$ : _
  3078.                 ZGSRAra$(ZTestedIntValue) = ZUserIn$
  3079.       GOTO 64110
  3080. 64114 IF LEFT$(ZOutTxt$(ScriptIndex),2) = "=#" THEN _        ' Numeric
  3081.          GOSUB 64350 : _
  3082.          GOTO 64110
  3083.       GOSUB 64300             ' process =
  3084.       GOTO 64445
  3085. 64120 ZWasZ$ = MID$(ZOutTxt$(ScriptIndex),2)   ' Execute macro
  3086.       CALL Trim (ZWasZ$)
  3087.       CALL Macro (ZWasZ$,Found)
  3088.       IF Found THEN _
  3089.           CALL FDMACEXE
  3090.       GOTO 64110
  3091. 64180 CALL CheckInt (ZOutTxt$)
  3092.       IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
  3093.           (ZTestedIntValue > ZMaxWorkVar) OR _
  3094.           (INSTR("123456789",LEFT$(ZOutTxt$,1)) = 0) THEN _
  3095.              ZTestedIntValue = 0 _
  3096.       ELSE ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-1+(ZTestedIntValue > 9))
  3097.       RETURN
  3098. 64190 GOSUB 64180
  3099.       IF ZTestedIntValue > 0 THEN _
  3100.          ZGSRAra$(ZTestedIntValue) = MID$(ZOutTxt$,2)
  3101.       GOTO 64110
  3102. '
  3103. '
  3104. ' *  SEARCH FOR GOTO LABEL
  3105. '
  3106. '
  3107. 64200 ScriptIndex = 1
  3108.       CALL MetaGSR (BranchLabel$,ZFalse)
  3109.       CALL SmartText (BranchLabel$,ZFalse,ZFalse)
  3110.       CALL AllCaps (BranchLabel$)
  3111.       CALL Trim (BranchLabel$)
  3112. 64210 ScriptIndex = ScriptIndex + 1
  3113.       IF ScriptIndex > ScriptMax THEN _
  3114.          ZOutTxt$ = BranchLabel$ + _
  3115.               " not found!" : _
  3116.          ZSubParm = 5 : _
  3117.          CALL TPut : _
  3118.          IF ZSubParm = -1 THEN _
  3119.             RETURN _
  3120.          ELSE IF LastQues > 0 THEN _
  3121.                  ScriptIndex = LastQues - 1 : _
  3122.                  RETURN _
  3123.               ELSE GOTO 64510
  3124.       IF LEFT$(ZOutTxt$(ScriptIndex),1) <> ":" THEN _
  3125.          GOTO 64210
  3126.       IF MID$(ZOutTxt$(ScriptIndex),2) <> BranchLabel$ THEN _
  3127.          GOTO 64210
  3128.       RETURN
  3129. '
  3130. '
  3131. ' *  DETERMINE BRANCH LOGIC
  3132. '
  3133. '
  3134. 64300 CurEquals = 1
  3135.       ZWasZ$ = RIGHT$(ZOutTxt$(LastQues + 1),1)
  3136.       CALL AllCaps (ZWasZ$)
  3137. 64310 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  3138.       IF NextEquals = 0 THEN _
  3139.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  3140.          GOTO 64320
  3141.       IF ZWasZ$ <> _
  3142.          MID$(ZOutTxt$(ScriptIndex),CurEquals + 1,1) THEN  _
  3143.          CurEquals = NextEquals : _
  3144.          GOTO 64310
  3145.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  3146. 64320 GOSUB 64200
  3147.       RETURN
  3148. '
  3149. '
  3150. ' *  DETERMINE Numeric BRANCH LOGIC
  3151. '
  3152. '
  3153. 64350 CurEquals = 1
  3154. 64360 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
  3155.       IF NextEquals = 0 THEN _
  3156.          BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
  3157.          GOTO 64380
  3158.       Numeric = ZTrue
  3159.       LoopIndex = 2
  3160.       WHILE LoopIndex < LEN(ZOutTxt$(ScriptIndex - 1)) +1
  3161.          IF INSTR("()1234567890- ",MID$(ZOutTxt$(ScriptIndex - 1),LoopIndex,1)) THEN _
  3162.             GOTO 64370
  3163.          Numeric = ZFalse
  3164. 64370    LoopIndex = LoopIndex + 1
  3165.       WEND
  3166.       IF NOT Numeric THEN _
  3167.          CurEquals = NextEquals : _
  3168.          GOTO 64360
  3169.       BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
  3170. 64380 GOSUB 64200
  3171.       RETURN
  3172. '
  3173. '
  3174. ' *  WRITE RESPONSES TO DESIGNATED FILE
  3175. '
  3176. '
  3177. 64400 ScriptIndex = 0
  3178.       ZWasEN$ = AppendFileName$
  3179.       CALL LockAppend
  3180.       IF ZErrCode <> 0 THEN _
  3181.          ZOutTxt$ = "Fatal Error in script!" : _
  3182.          ZSubParm = 5 : _
  3183.          CALL TPut : _
  3184.          GOTO 64500
  3185. 64410 ScriptIndex = ScriptIndex + 1
  3186.       IF ScriptIndex > ScriptMax THEN _
  3187.          GOTO 64500
  3188.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
  3189.          QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _
  3190.          GOTO 64410
  3191.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _
  3192.          LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _
  3193.          GOTO 64410
  3194.       IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _
  3195.          CALL PrintWorkA (QuestionSave$) : _
  3196.          CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2))
  3197.       IF ScriptIndex = 1 AND _
  3198.          AppendFileName$ <> PrevAppend$ THEN _
  3199.          CALL PrintWorkA (ZOutTxt$(ScriptIndex))
  3200.       IF ZErrCode <> 0 THEN _
  3201.          ZOutTxt$ = "Unrecoverable failure in script!" : _
  3202.          ZSubParm = 5 : _
  3203.          CALL TPut : _
  3204.          GOTO 64500
  3205.       GOTO 64410
  3206. 64420 ZQuestAborted = ZTrue  ' @ abort
  3207.       GOTO 64510
  3208. 64430 ZTurboKey = -ZTurboKeyUser   ' T turbo key
  3209.       GOTO 64110
  3210. 64440 BranchLabel$ = ZOutTxt$            ' = branch
  3211.       GOSUB 64200
  3212. 64445 IF ZSubParm = -1 THEN _
  3213.          GOTO 64510 _
  3214.       ELSE GOTO 64110
  3215. 64450 ZSubParm = 5      ' * display
  3216.       CALL TPut
  3217.       GOTO 64445
  3218. 64460 WasX = -1        ' - lower security
  3219. 64462 CALL CheckInt (ZOutTxt$)
  3220.       IF ZErrCode = 0 THEN _
  3221.          Temp = ZUserSecLevel + _
  3222.             WasX * ZTestedIntValue : _
  3223.          IF Temp <= MaxSecLevel THEN _
  3224.             ZUserSecLevel = Temp : _
  3225.             ZUserSecSave = ZUserSecLevel : _
  3226.             ZAdjustedSecurity = ZTrue
  3227.       GOTO 64110
  3228. 64465 WasX = 1               ' + raise security
  3229.       GOTO 64462
  3230. 64470 QestChain = ZTrue  ' & chain questionnaires
  3231.       ZFileNameHold$ = ZOutTxt$
  3232.       GOTO 64110
  3233. 64500 CALL UnLockAppend
  3234.       CALL Carrier
  3235.       IF QestChain THEN _
  3236.          ZQuestChainStarted = ZTrue : _
  3237.          ZFileName$ = ZFileNameHold$ : _
  3238.          GOTO 64005
  3239. 64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0)
  3240.       ZOK = ZTrue
  3241.       ZLastIndex = 0
  3242.       END SUB
  3243. 64600 ' $SUBTITLE: 'ViewArc - subroutine to display .ARC contents'
  3244. ' $PAGE
  3245. '
  3246. '  NAME    --  ViewArc  (Written by Jon Martin)
  3247. '
  3248. '  INPUTS  --  PARAMETER                   MEANING
  3249. '              ZFileName$           NAME OF THE ARC FILE TO BE
  3250. '                                   VIEWED.
  3251. '
  3252. '  OUTPUTS --  NONE
  3253. '
  3254. '  PURPOSE --  Provides a mechanism to provide users with the
  3255. '              contents of a libraried file prior to downloading.
  3256. '
  3257.       SUB ViewArc STATIC
  3258.       CLOSE 2
  3259.       'IF ZTurboRBBS THEN _
  3260.          RetCode = 0
  3261.          CALL ArcV (ZArcWork$,ZFileName$,RetCode)
  3262.          CALL BufFile (ZArcWork$,WasX)
  3263.          EXIT SUB
  3264.       'IF ZShareIt THEN _
  3265.       '   OPEN ZFileName$ FOR RANDOM SHARED AS #2 LEN=1 _
  3266.       'ELSE OPEN "R",2,ZFileName$,1
  3267.       'FIELD 2,1 AS CHAR$
  3268.       'BYTE.POINTER! = 1
  3269.       'ARC.END! = LOF(2)
  3270. 64605 'IF BYTE.POINTER! > ARC.END! THEN _
  3271.       '   GOTO 64620
  3272.       'GET 2,BYTE.POINTER!
  3273.       'IF CHAR$ <> CHR$(26) THEN _
  3274.       '   GOTO 64620
  3275.       'BYTE.POINTER! = BYTE.POINTER! + 1
  3276.       'GET 2,BYTE.POINTER!
  3277.       'IF CHAR$ = CHR$(0) THEN _
  3278.       '   GOTO 64620
  3279.       'ARCED.NAME$ = ""
  3280.       'FOR WasX = 1 TO 12
  3281.       '   GET 2,BYTE.POINTER! + WasX
  3282.       '   IF CHAR$ < CHR$(40) THEN _
  3283.       '      GOTO 64610
  3284.       '   ARCED.NAME$ = ARCED.NAME$ + _
  3285.       '                 CHAR$
  3286.       'NEXT
  3287. 64610 'ZOutTxt$ = ARCED.NAME$
  3288.       'BYTE.POINTER! = BYTE.POINTER! + 14
  3289.       'GOSUB 64630
  3290.       'TOTAL.BYTES# = WORK.BYTES#
  3291.       'BYTE.POINTER! = BYTE.POINTER! + 10
  3292.       'GOSUB 64630
  3293.       'FINAL.BYTES# = WORK.BYTES#
  3294.       'ZOutTxt$ = ZOutTxt$ + _
  3295.       '     SPACE$(20 - LEN(ARCED.NAME$) - LEN(STR$(FINAL.BYTES#))) + _
  3296.       '     STR$(FINAL.BYTES#) + _
  3297.       '     " bytes."
  3298.       'CALL QuickTPut1 (ZOutTxt$)
  3299.       'BYTE.POINTER! = BYTE.POINTER! + TOTAL.BYTES# + 4
  3300.       'GOTO 64605
  3301. 64620 'CLOSE 2
  3302.       'ZSubParm = 0
  3303.       'CALL Carrier
  3304.       'ZOutTxt$ = ""
  3305.       'EXIT SUB
  3306. 64630 'FACTOR# = 1#
  3307.       'WORK.BYTES# = 0
  3308.       'FOR WasX = 0 TO 3
  3309.       '   GET 2,BYTE.POINTER! + WasX
  3310.       '   WORK.BYTES# = WORK.BYTES# + FACTOR# * ASC(CHAR$)
  3311.       '   FACTOR# = FACTOR# * 256#
  3312.       'NEXT
  3313.       'RETURN
  3314.       END SUB
  3315.