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