' $linesize:132
' $title: 'RBBSSUB4.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack'  ' DA081003
'  Copyright 1990 by D. Thomas Mack, all rights reserved.
'  Name ...............: RBBSSUB4.BAS
'  First Released .....: February 11, 1990
'  Subsequent Releases.: August 26, 1990; October 28, 1990
'  Copyright ..........: 1986 - 1990
'  Purpose.............: The Remote Bulletin Board System for the IBM PC,
'     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
'     require error trapping are incorporated within RBBSSUB 2-5 as
'     separately callable subroutines in order to free up as much
'     code as possible within the 64K code segment used by RBBS-PC.BAS.
'  Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine  Line               Function of Subroutine
'   Name     Number
'  AnyBut         59760  Determine where a "word" begins
'  AskUsers       64003  Ask users questions based on a script and save answers
'  AskMore        59858  Check whether screen full
'  AutoPage       60300  Check whether to notify sysop caller is on
' BadFileChar     59800  Check file name for bad character
'  Bracket        59960  Puts strings around a substring
'  BufFile        58400  Write a file to the user quickly
'  BufString      58300  Write a string with imbedded CR/LF to the user quickly
'  CheckColor     59930  Highlighting based on search string
'  SearchArray    58190  Check for the occurance of a string in an array
'  ColorDir       59920  Adds colorization to FMS directory entry
'  ColorPrompt    59940  Colorizes prompts
'  CompDate       59880+ Produces a computational data from YY, MM, DD
'  ConfMail       59854  Check conference mail waiting
'  ConvertDir     58950  Checks for U & A (shorthand) and converts appropriately
'  PackDate       59201  Compress date in string format to 2 characters
'  EofComm        60000  Determine whether any chars in comm port buffer
'  ExpireDate     59890  Calculate registration expiration date
'  FakeXRpt       62650  Write out file transfer report for protocols that don't
'  FindEnd        58770  Find where a "word" ends
'  FindFile       58790  Determine whether a file exists without opening it
'  FindLast       58600  Find last occurence of a string
'  FMS            58200  Search the upload management system for entries
'  GetAll         59780  Get list of all directories to display
'  GetDirs        58895  Prompts for directories for file list/new/search cmds
'  GetMsgAttr     62530  Restore attributes of original message
'  GetYMD         59204  Pulls YY, MM, or DD from a 2 byte stored date
'  GlobalSrchRepl 60100  Global search and replace
'  LogPDown       59400  Records download in private directory
'  MarkTime       60200  Give visual feedback during lengthy process
'  MetaGSR        60130  Meta statement global search and replace
'  MsgImport      59698  Allow local user to import a text file to a message
'  Muzak          59100  Play musical themes for different RBBS functions
'  NewPassword    60668  Get a new password
'  PersFile       59300  View and select personal files for downloading
'  Protocol       62600  Determine if external protocols are available
'  PutMsgAttr     62520  Save attributes of original message
'  Remove         58210  Remove characters from within strings
'  RotorsDir      58700  Searches for a file using list of subdirs
'  RptTime        62540  Report date/time and time on
'  SetEcho        59600  Set RBBS properly for who is to echo
'  SetHiLite      59934  Set user preference on highlighting
'  SetGraphic     59980  Sets graphic preference for text file display
'  SmartText      58250  Process SMART TEXT control strings
'  SubMenu        59500  Processes options that have sub-menus
'  TimedOut       63000  Write timed exit semaphore file
'  TimeLock       60180  Check for TIME LOCK on certain features
'  Transfer       62624  RBBS-PC support for external protocols for file transfer
'  Toggle         57000  Toggles or views user options
' TwoByteDate     59200  Reduces a data to 2 byte string for space compression
'  UnPackDate     59902  Uncompresses a 2 byte date
'  UserColor      59965  Lets user set color for text and whether bold
'  UserFace       59450  Processes programmable user interface
'  ViewArc        64600  Display .ARC file contents to user
'  PrivDoorRtn    62629  Private door exit routine
'  WipeLine       58800  Wipes away a line so next prints in its place
'  WordWrap       59710  Adjust a msg -- wrap lines and perserve paragraphs
'
'  $INCLUDE: 'RBBS-VAR.BAS'
'
57000 ' $SUBTITLE: 'Toggle - Toggle User Preferences'
' $PAGE
'
'  NAME    -- Toggle
'
'  INPUTS  -- ToggleOption      Option to toggle or view
'                               according to the following:
'    ToggleOption         PREFERENCE
'   Toggle   VIEW
'     1       -1           Autodownload
'     2       -2           Bulletin review on logon
'     3       -3           Case change
'     4       -4           File review on logon
'     5       -5           Highlight
'     6       -6           Line feeds
'     7       -7           Nulls
'     8       -8           TurboKey
'     9       -9           Expert
'    10      -10           Bell
'
'  OUTPUTS -- ZSubParm   passed from TPut
'
'  PURPOSE -- Sets or views any single user preference value
'
      SUB Toggle (ToggleOption) STATIC
      ZSubParm = 0
      IF ToggleOption < 0 THEN _
         GOTO 57005
      ON ToggleOption GOSUB _
         57010, _         'Autodownload
         57120, _         'Bulletin review on logon
         57260, _         'Case change
         57150, _         'File review on logon
         57040, _         'Highlight
         57100, _         'Line feeds
         57210, _         'Nulls
         57230, _         'TurboKey
         57190, _         'Expert
         57170            'Bell
      EXIT SUB
57005 CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue)
      ON -ToggleOption GOSUB _
         57030, _         'Autodownload
         57130, _         'Bulletin review on logon
         57270, _         'Case change
         57160, _         'File review on logon
         57050, _         'Highlight
         57110, _         'Line feeds
         57220, _         'Nulls
         57240, _         'TurboKey
         57200, _         'Expert
         57180            'Bell
      EXIT SUB
57010 IF ZAutoDownDesired THEN _
         GOTO 57020
      IF NOT ZAutoDownVerified THEN _
         CALL TestUser
      IF NOT ZAutoDownYes THEN _
         CALL QuickTPut1 ("Your comm pgm does not support AUTODOWNLOAD") : _
         ZAutoDownDesired = ZTrue
57020 ZAutoDownDesired = NOT ZAutoDownDesired
57030 ZOutTxt$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
     CALL QuickTPut1 (ZOutTxt$)
     RETURN
57040 IF ZEmphasizeOnDef$ = "" THEN _
        CALL QuickTPut1 ("Highlighting unavailable") : _
        RETURN
     IF NOT ZHiLiteOff THEN _
        CALL QuickTPut (ZColorReset$,0)
     CALL SetHiLite (NOT ZHiLiteOff)
     GOSUB 57050
     CALL UserColor
     RETURN
57050 IF ZEmphasizeOn$ <> "" THEN _
        ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
        ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
     CALL QuickTPut1 (ZEmphasizeOn$ + "Highlighting" + ZEmphasizeOff$ + _
                 " " + FNOffOn$(NOT ZHiLiteOff))
     RETURN
57100 ZLineFeeds = NOT ZLineFeeds
      IF ZLocalUser THEN _
         ZLineFeeds = ZTrue
57110 CALL QuickTPut1 ("Line Feeds " + FNOffOn$(ZLineFeeds))
      CALL SetCrLf
      RETURN
57120 ZCheckBulletLogon = NOT ZCheckBulletLogon
57130 ZOutTxt$ = MID$("Skip Check",1 -5 * ZCheckBulletLogon,5) + _   ' DA071701
           " old Bulletins in logon"                                 ' DA071701
      CALL QuickTPut1 (ZOutTxt$)
      RETURN
57150 ZSkipFilesLogon = NOT ZSkipFilesLogon
57160 ZOutTxt$ = MID$("CheckSkip",1 -5 * ZSkipFilesLogon,5) + _      ' DA071701
           " new files in logon"
      CALL QuickTPut1 (ZOutTxt$)
      RETURN
57170 ZPromptBell = NOT ZPromptBell
57180 ZOutTxt$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
      CALL QuickTPut1 (ZOutTxt$)
      RETURN
57190 ZExpertUser = NOT ZExpertUser
      CALL SetExpert
57200 ZOutTxt$ = MID$("NoviceExpert",1 -6 * ZExpertUser,6)
      CALL QuickTPut1 (ZOutTxt$)
      RETURN
57210 ZNulls = NOT ZNulls
      ZNul$ = MID$(STRING$(5,0),1, - 5 * ZNulls)
      CALL SetCrLf
57220 ZOutTxt$ = "Nulls " + FNOffOn$(ZNulls)
      CALL QuickTPut1 (ZOutTxt$)
      RETURN
57230 ZTurboKeyUser = NOT ZTurboKeyUser
57240 CALL QuickTPut1 ("TurboKey " + FNOffOn$(ZTurboKeyUser))
      RETURN
57260 ZUpperCase = NOT ZUpperCase
57270 ZOutTxt$ = "UPPER CASE " + _
            MID$("and lowerONLY",1 - 9 * ZUpperCase,9)
      CALL QuickTPut1 (ZOutTxt$)
57280 ZUseTPut = (ZUpperCase OR ZXOnXOff)
      RETURN
      END SUB
'
58190 ' $SUBTITLE: 'SearchArray - subroutine to check for a string in an array'
' $PAGE
'
'  NAME    -- SearchArray
'
'  INPUTS  -- PARAMETER                      MEANING
'             Element$                THE STRING TO CHECK FOR
'             Array$()                THE ARRAY TO BE SEARCHED
'             NumEntriesToSearch      NUMBER OF ENTRIES WITHIN IN
'                                     THE ARRAY TO BE SEARCHED
'
'  OUTPUTS -- IsInAra                 0 = STRING NOT Found IN THE
'                                         ARRAY SPECIFIED
'                                     OTHERWISE IT IS THE NUMBER sOF
'                                     ELEMENT WITHIN THE ARRAY THAT
'                                     WAS Found TO MATCH
'
'  PURPOSE -- Search an array for a specified string and, if found,
'             return the number of the element that matched.
'
      SUB SearchArray (Element$,Array$(1),NumEntriesToSearch,IsInAra) STATIC
      IsInAra = 1
      CALL AllCaps (Element$)
      MaxTries = NumEntriesToSearch + 1
      Array$(MaxTries) = Element$
      WHILE Array$(IsInAra) <> Element$
         IsInAra = IsInAra + 1
      WEND
      IF IsInAra = MaxTries THEN _
         IsInAra = 0
      END SUB
58200 ' $SUBTITLE: 'FMS - subroutine to search the upload management system'
' $PAGE
'
'  NAME    -- FMS
'
'  INPUTS  -- PARAMETER                      MEANING
'             DirToSearch$          RBBS-PC "DIR" CATEGORY TO LOOK
'                                     FOR
'             SearchString$          STRING TO SEARCH FOR
'             SearchDate$            DATE TO SEARCH FOR
'             ZCategoryName$()
'             ZCategoryCode$()
'             ZCategoryDesc$()
'             CatFound
'             ZNumCategories
'
'  OUTPUTS -- ProcessedInFMS
'             DnldFlag
'
'  PURPOSE -- To search the file management system and display the
'             files being searched for as well as the catetory descriptions
'
      SUB FMS (DirToSearch$,SearchString$,SearchDate$, _
               ProcessedInFMS,ZCategoryName$(1),ZCategoryCode$(1), _
               ZCategoryDesc$(1),DnldFlag,CatFound,AbortIndex) STATIC
      DnldFlag = 0
      CALL SearchArray (DirToSearch$,ZCategoryName$(),ZNumCategories,CatFound)
      ProcessedInFMS = ProcessedInFMS OR (CatFound > 0)
      IF ProcessedInFMS THEN _
         ZSubParm = 5 : _
         GOSUB 58202 : _
         ZOutTxt$ = "Scanning directory " + _
              DirToSearch$ + _
              SrchDir$ + _
              " - " + _
              ZCategoryDesc$(CatFound) : _
         CALL TPut : _
         Cat$ = ZCategoryCode$(CatFound) : _
         CALL DispUpDir (Cat$,SearchString$,SearchDate$,DnldFlag,AbortIndex)
      EXIT SUB
58202 ZOutTxt$ = SearchDate$
      IF LEN(ZOutTxt$) > 0 THEN _
         ZOutTxt$ = MID$(ZOutTxt$,3) + LEFT$(ZOutTxt$,2)
      SrchDir$ = " for " + _
             SearchString$ + _
             ZOutTxt$
      IF LEN(SrchDir$) < 6 THEN _
         SrchDir$ = ""
      RETURN
      END SUB
58210 ' $SUBTITLE: 'Remove - subroutine to delete a string from within a string'
' $PAGE
'
'  NAME    -- Remove
'
'  INPUTS  -- PARAMETER                      MEANING
'             BADSTRING$              STRING CONTAINING CHARACTERS
'                                     TO BE DELETED FROM "WasL$"
'             WasL$                      STRING TO BE ALTERED
'
'  OUTPUTS -- WasL$                      WITH THE CHARACTERS IN
'                                     "BADSTRING#" DELETED FROM IT
'
'  PURPOSE -- To remove all instances of the characters in
'                        "BADSTRING$" from "WasL$"
'
      SUB Remove (WasL$,BadString$) STATIC
      WasJ = 0
      FOR WasI=1 TO LEN(WasL$)
         IF INSTR(BadString$,MID$(WasL$,WasI,1)) = 0 THEN _
            WasJ = WasJ + 1 : _
            MID$(WasL$,WasJ,1) = MID$(WasL$,WasI,1)
      NEXT WasI
      WasL$ = LEFT$(WasL$,WasJ)
      END SUB
'
58250 ' $SUBTITLE: 'SmartText - smart text substitution'
' $PAGE
'
'  NAME    -- SmartText   (WRITTEN BY DOUG AZZARITO)
'
'  INPUTS  -- StringWork$        string to scan for Smart Text
'             CRFound            Does this line contain a CR?
'             ZSmartTextCode     Smart Text control code
'
'  OUTPUTS -- StringWork$        Input string with Smart replaced
'
'  PURPOSE -- Smart Text allows control strings in text files
'             to be replaced at runtime with user info or other
'             data.  The Smart Text control code is a 1-byte
'             code (configurable) with a 2-byte action code.
'
      SUB SmartText (StringWork$, CRFound, OverStrike) STATIC
      IF SmartCarry$<>"" THEN _
         StringWork$ = SmartCarry$+StringWork$
      Index = INSTR(StringWork$, ZSmartTextCode$)
      WHILE Index > 0 AND Index < LEN(StringWork$)-1
         IF INSTR(MID$(StringWork$, Index+1,2)," ") THEN _
            SmartAct = 0 _
         ELSE _
            SmartAct = INSTR(ZSmartTable$, MID$(StringWork$, Index+1, 2))
         IF SmartAct = 0 THEN _
            WasI = 1 : _
            GOTO 58254
         SmartAct = (SmartAct+2)/3
         ON SmartAct GOSUB 58260, 58261, 58262, 58263, 58264, 58265, _
                           58266, 58267, 58268, 58269, 58270, _
                           58271, 58272, 58273, 58274, 58275, _
                           58276, 58277, 58278, 58279, 58280, _
                           58281, 58282, 58283, 58284, 58285, _
                           58286, 58287, 58289, 58290, 58291, _
                           58292, 58293, 58294
         GOSUB 58256
         WasI = LEN(SmartHold$)
         ReplaceLen = 3
         IF OverStrike OR Overlay THEN _
            IF WasI > 2 THEN _
               ReplaceLen = WasI _
            ELSE _
               SmartHold$ = SmartHold$ + SPACE$(3 - WasI)
         StringWork$ = LEFT$(StringWork$, Index-1) + SmartHold$ + _
                       MID$(StringWork$,Index+ReplaceLen)
58254    Index = INSTR(Index+WasI, StringWork$, ZSmartTextCode$)
      WEND
      IF Index AND (Index > LEN(StringWork$)-2) AND NOT CRFound THEN _
         SmartCarry$ = MID$(StringWork$,Index) : _
         StringWork$ = LEFT$(StringWork$,Index-1) : _
      ELSE _
         SmartCarry$ = ""
      EXIT SUB
58256 IF TrimSmart THEN _
         CALL Trim (SmartHold$)
      RETURN
58258 ZLastSmartColor$ = SmartHold$
      RETURN
58260 ZLinesPrinted = 0                     ' CS (Clear screen line count reset)
      SmartHold$ = ""
      RETURN
58261 ZLinesPrinted = ZPageLength           ' PB Page Break
      IF ZNonStop THEN _                    ' force a 1-time pause
         ZOneStop = ZTrue : _               ' if NON STOP is on
         ZNonStop = ZFalse
      SmartHold$ = ""
      ZForceKeyboard = ZTrue
      RETURN
58262 ZNonStop = ZTrue                      ' NS Non-stop
      SmartHold$ = ""
      RETURN
58263 IF ZGlobalSysop THEN _                ' FN First Name
         SmartHold$ = ZOrigSysopFN$ _
      ELSE SmartHold$ = ZFirstName$
      CALL NameCaps(SmartHold$)
      RETURN
58264 IF ZGlobalSysop THEN _
         SmartHold$ = ZOrigSysopLN$ _
      ELSE SmartHold$ = ZLastName$
      CALL NameCaps(SmartHold$)
      RETURN
58265 SmartHold$ = MID$(STR$(ZUserSecLevel),2)   ' SL Security level
      RETURN
58266 SmartHold$ = DATE$                         ' DT Date           ' KG021801
      RETURN
58267 CALL AMorPM
      SmartHold$ = ZTime$                        ' TM Time           ' KG021801
      RETURN
58268 CALL TimeRemain(MinsRemaining)
      SmartHold$ = MID$(STR$(INT(MinsRemaining)),2)
      RETURN
58269 CALL TimeRemain(MinsRemaining)      ' TE Time elapsed (mm:ss)
      SmartHold$ = MID$(STR$(INT(ZSecsUsedSession!/60)),2)+":"+ _
         MID$(STR$((ZSecsUsedSession! MOD 60)+100),3)
      RETURN
58270 SmartHold$ = MID$(STR$(INT((ZTimeLockSet+0.5)/60)),2) ' TL - Time Lock period
      SmartHold$ = SmartHold$ + ":"+ MID$(STR$((ZTimeLockSet MOD 60)+100),3)
      RETURN
58271 SmartHold$ = MID$(STR$(ZDaysInRegPeriod),2)
      RETURN                                ' RP Registration Length
58272 SmartHold$ = MID$(STR$(ZRegDaysRemaining),2)
      RETURN                                ' RR Registration Remaining
58273 SmartHold$ = ZCityState$              ' CT Users CITY & STATE
      RETURN
58274 SmartHold$ = ZFG1$                    ' C1 Color 1
      GOTO 58258
58275 SmartHold$ = ZFG2$                    ' C2 Color 2
      GOTO 58258
58276 SmartHold$ = ZFG3$                    ' C3 Color 3
      GOTO 58258
58277 SmartHold$ = ZFG4$                    ' C4 Color 4
      GOTO 58258
58278 SmartHold$ = ZEmphasizeOff$           ' C0 Reset color
      ZLastSmartColor$ = ""
      RETURN
58279 SmartHold$ = MID$(STR$(INT(ZDLToday!)),2)
      RETURN                                ' DD files Dnlded TODAY
58280 SmartHold$ = MID$(STR$(INT(ZBytesToday!)),2)
      RETURN                                ' BD Bytes Dnlded TODAY
58281 SmartHold$ = MID$(STR$(INT(ZDLBytes!)),2)
      RETURN                                ' DB Download Bytes
58282 SmartHold$ = MID$(STR$(INT(ZULBytes!)),2)
      RETURN                                ' UB Upload Bytes
58283 SmartHold$ = MID$(STR$(ZDnlds),2)     ' DL Number of Dnlds
      RETURN
58284 SmartHold$ = MID$(STR$(ZUplds),2)     ' UL Number of Uplds
      RETURN
58285 SmartHold$ = ZFileName$               ' FI  File Name
      RETURN
58286 Overlay = ZTrue                       ' VY Overlay ON
      GOTO 58288
58287 Overlay = ZFalse                      ' VN Overlay OFF
58288 SmartHold$ = ""
      RETURN
58289 TrimSmart = ZTrue                     ' TY Trim Yes
      GOTO 58288
58290 TrimSmart = ZFalse                    ' TN Trim No
      GOTO 58288
58291 SmartHold$ = ZRBBSName$               ' BN Board Name
      RETURN
58292 SmartHold$ = ZNodeID$                 ' ND Node Number
      IF SmartHold$ >= "A" THEN _
         SmartHold$ = MID$(STR$(ASC(SmartHold$) - 54),2)
      RETURN
58293 SmartHold$ = ZSysopFirstName$          ' FS Sysops First Name
      CALL NameCaps(SmartHold$)
      RETURN
58294 SmartHold$ = ZSysopLastName$          ' LS Sysops First Name
      CALL NameCaps(SmartHold$)
      RETURN
      END SUB
'
58300 ' $SUBTITLE: 'BufString - write a string with imbedded ZCR/LF'
' $PAGE
'
'  NAME    -- BufString
'
'  INPUTS  -- PARAMETER                      MEANING
'             Strng$                  STRING TO BE WRITTEN OUT
'             DataSize               LENGTH OF STRING - # LEFT
'                                        CHARS TO OUTPUT
'
'  OUTPUTS -- Strng$                  IS WRITTEN TO THE USER
'
'  PURPOSE -- To search the string, Strng$, for embedded carriage
'             returns and line feeds and write out each line with
'             the appropriate substitution (cr/lf if to the local
'             screen or cr/nulls/lf if to the communications port).
'
      SUB BufString (Strng$,PassedDataSize,AbortIndex) STATIC
      WasL = LEN(Strng$)
      IF PassedDataSize < WasL THEN _
         WasL = PassedDataSize
      IF WasL < 1 THEN _
         EXIT SUB
      ZFF = ZPageLength - 1
      StartByte = 1
      ZRet = ZFalse
      IF CarryOver THEN _
         IF ASC(Strng$) = 10 THEN _
            StartByte = 2 : _
            CALL SkipLine (1+ZJumpSearching)
      CarryOver = (MID$(Strng$,WasL,1) = ZCarriageReturn$)
      WasL = WasL + CarryOver
58301 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
      IF CRat > 0 AND CRat < WasL THEN _
         CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
      ELSE CRFound = ZFalse
      EOLlen = -2 * CRFound
      IF CRFound THEN _
         EOD = CRat _
      ELSE EOD = WasL + 1
      NumBytes = EOD - StartByte
      StringWork$ = MID$(Strng$,StartByte,NumBytes)
      IF NOT ZDeleteInvalid THEN _
         GOTO 58302                                                  ' DA061002
      Index = INSTR(StringWork$,"[")
      WasJ = LEN(StringWork$) - 1
      WHILE Index > 0 AND Index < WasJ
         IF MID$(StringWork$,Index + 2,1) = "]" THEN _
            IF INSTR (ZInvalidOpts$,MID$(StringWork$,Index + 1,1)) THEN _
               MID$(StringWork$,Index + 1,1) = "*"
         Index = INSTR(Index + 1,StringWork$,"[")
      WEND
58302 IF ZJumpSearching THEN _                                       ' DA061002
         Temp$ = StringWork$ : _
         CALL AllCaps (Temp$) : _
         HiLitePos = INSTR (Temp$,ZJumpTo$) : _
         IF HiLitePos = 0 THEN _
            GOTO 58307 _
         ELSE CALL Bracket (StringWork$,HiLitePos,HiLitePos+LEN(ZJumpTo$)-1,ZEmphasizeOn$,ZEmphasizeOff$) : _
              ZJumpSearching = ZFalse
      IF ZSmartTextCode THEN _
         CALL SmartText (StringWork$, CRFound, ZFalse)
      IF NOT ZLocalUser THEN _                                       ' DA061002
         CALL EofComm (Char) : _                                     ' DA061002
         IF Char <> -1 THEN _                                        ' DA061002
            GOTO 58303            ' comm port input                  ' DA061002
      ZKeyboardStack$ = INKEY$ : _                                   ' DA061002
      IF ZKeyboardStack$ <> "" THEN _  ' keyboard input              ' DA061002
         GOTO 58303                                                  ' DA061002
      CALL QuickTPut (StringWork$, - (CRFound))                      ' DA061002
      GOTO 58304                                                     ' DA061002
58303 ZOutTxt$ = StringWork$                                         ' DA061002
      ZSubParm = 4                                                   ' DA061002
      IF CRFound THEN ZSubParm = 5                                   ' DA061002
      CALL TPut                                                      ' DA061002
58304 IF ZRet THEN _                                                 ' DA061002
         EXIT SUB
      IF ZLinesPrinted < ZFF THEN _
         GOTO 58307
58305 CALL CheckTimeRemain (MinsRemaining)
      CALL CheckCarrier
      IF ZSubParm = -1 THEN _
         EXIT SUB
      IF ZNonStop THEN _
         GOTO 58307
      IF NOT CRFound THEN _
         GOTO 58307
      ZForceKeyboard = ZTrue
      CALL AskMore ("",ZTrue,ZFalse,AbortIndex,ZStopInterrupts)
      IF ZNo THEN _
         ZRet = ZTrue : _
         EXIT SUB
58307 StartByte = EOD + EOLlen
      IF StartByte <= WasL THEN _
         GOTO 58301
      END SUB
58400 ' $SUBTITLE: 'BufFile - subroutine to write a sequential file to the user'
' $PAGE
'
'  NAME    -- BufFile
'
'  INPUTS  -- PARAMETER                      MEANING
'             FileSpec$               NAME OF THE FILE TO WRITE TO
'                                                OUT TO THE USER
'
'  OUTPUTS -- NONE                    FILE IS WRITTEN TO THE USER
'
'  PURPOSE -- To display a sequential file to the user
'
      SUB BufFile (FilName$,AbortIndex) STATIC
      CALL FindIt (FilName$)
      IF NOT ZOK THEN _
         GOTO 58419
      ZNo = ZFalse
      CALL OpenRSeq (FilName$,NumRecs,LenLastRec,ZBufferSize)
      DataSize = ZBufferSize
      FIELD 2, DataSize AS SeqRec$
      ZNonStop = ZNonStop OR (ZPageLength < 1)
      ZJumpLast$ = ""
      ZJumpSearching = ZFalse
      ZJumpSupported = ZTrue
      IF NOT ZStopInterrupts THEN _
         IF NOT ZConcatFIles THEN _
            IF NOT ZNonStop THEN _
               ZOutTxt$ = "* Ctrl-K(^K) / ^X aborts. ^S suspends ^Q resumes *" : _
               ZSubParm = 2 : _
               CALL TPut
      WasTU = 0
58405 WasTU = WasTU + 1
      IF WasTU < NumRecs THEN _
         GET 2,WasTU _
      ELSE IF WasTU = NumRecs THEN _
              GET 2,WasTU : _
              WasX = INSTR(SeqRec$,CHR$(26)) : _
              IF WasX = 0 OR WasX > LenLastRec THEN _
                 DataSize = LenLastRec _
              ELSE DataSize = WasX - 1 _
           ELSE GOTO 58419
      CALL BufString (SeqRec$,DataSize,AbortIndex)                   ' DA061002
58408 IF ZSubParm <> -1 AND NOT ZRet THEN _
         GOTO 58405
58419 CLOSE 2
      ZBypassTimeCheck = ZFalse
      ZStopInterrupts = ZFalse
      CALL QuickTPut (ZEmphasizeOff$,0)
      ZJumpSupported = ZFalse
      END SUB
58600 ' $SUBTITLE: 'FindLast - find last occurence of a string'
' $PAGE
'
'  NAME    -- FindLast
'
'  INPUTS  -- PARAMETER             MEANING
'              LookIn$           STRING TO LOOK INTO
'              LookFor$          STRING TO SEARCH FOR
'
'  OUTPUTS -- WhereFound        POSITION IN LookIn$ THAT
'                                   LookFor$ Found
'             NumFinds          HOW MANY OCCURENCES IN LookIn$
'
'  PURPOSE -- Finds last occurence of LookFor$ in LookIn$ and
'             returns count of # of occurences.  If none found,
'             both returned parameters are set to 0.
'
      SUB FindLast (LookIn$,LookFor$,WhereFound,NumFinds) STATIC
      WhereFound = INSTR(LookIn$,LookFor$)
      NumFinds = -(WhereFound > 0)
      NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
      WHILE NextFound > 0
         NumFinds = NumFinds + 1
         WhereFound = NextFound
         NextFound = INSTR(WhereFound + 1,LookIn$,LookFor$)
      WEND
      END SUB
58700 ' $SUBTITLE: 'RotorsDir - search thru a list of subdirs for a file'
' $PAGE
'
'  NAME    -- RotorsDir
'
'  INPUTS  --     PARAMETER                    MEANING
'             FilName$                  FILE NAME TO LOOK FOR
'             SDIR.ARA                  ARRAY OF SUBDIRECTORIES
'             MaxSearch                 MAX # OF SUBDIRECTORIES
'             MarkingTime               WHETHER TO MARK TIME
'
'  OUTPUTS -- FNAME$                    ADD SUBDIRECTORY TO THE
'                                       FILE NAME IF FOUND.  OTHER-
'                                       WISE DON'T.
'             ZOK                       TRUE IF FILE WAS Found
'
'  PURPOSE -- Hunt through a list of subdirectories to determine
'             if a file is in any of them.  If file is found, open
'             the file as file #2, add the drive/path to the file
'             name, and sets ZOK to true.  If file isn't found, set
'             file name to the last subdirectory searched -- which
'             should be the upload subdirectory.
'
'             If the library menu is selected (ZMenuIndex = 6), then
'             only 2 subdirectories are searched. The first being
'             the work disk and the second being the selected
'             library disk.
'
      SUB RotorsDir (FilName$,SDirAra$(1),MaxSearch,MarkingTime,PassToMacro$) STATIC ' KG022204
      ZOK = ZFalse
      ZDotFlag = ZFalse
      IF MarkingTime THEN _
         CALL QuickTPut ("Searching for "+FilName$,0)
      IF ZMenuIndex = 6 THEN _
         GOTO 58705
      NumSearch = 1
      WasX = 0
      WHILE (NOT ZOK) AND NumSearch <= MaxSearch AND _
         SDirAra$(NumSearch) <> ""
         IF MarkingTime THEN _
            CALL MarkTime (WasX)
         WasX$ = SDirAra$(NumSearch) + _
              FilName$
         CALL FindFile (WasX$,ZOK)
         NumSearch = NumSearch + 1
      WEND
      IF ZOK OR NOT ZFastFileSearch THEN _                           ' KG022301
         GOTO 58710                                                  ' KG022301
      CALL OpenRSeq (ZFastFileList$,HighRec,WasX,18)                 ' KG022301
      IF ZErrCode <> 0 THEN _                                        ' KG022301
         GOTO 58710                                                  ' KG022301
      CALL TrimTrail (FilName$,".")
      CALL BinSearch (FilName$,1,12,18,HighRec,RecFoundAt, RecFound$)
      ZOK = (RecFoundAt > 0)
      IF NOT ZOK THEN _                                              ' KG022301
         GOTO 58710                                                  ' KG022301
      ZOK = ZFalse
      CALL CheckInt (MID$(RecFound$,13,4))
      IF ZTestedIntValue < 1 THEN _                                  ' KG022301
         GOTO 58710                                                  ' KG022301
      CALL OpenRSeq (ZFastFileLocator$,HighRec,WasX,66)
      IF ZErrCode <> 0 OR ZTestedIntValue > HighRec THEN _           ' KG022301
         GOTO 58710                                                  ' KG022301
      FIELD 2, 66 AS LocatorRec$
      GET 2, ZTestedIntValue
      WasX$ = LEFT$(LocatorRec$,63)
      CALL Trim (WasX$)
      IF LEFT$(WasX$,2) = "M!" THEN _
         ZOK = ZFalse : _                                            ' KG022301
         ZGSRAra$(1) = PassToMacro$ : _                              ' KG022204
         WasX$ = RIGHT$(WasX$,LEN(WasX$)-2) : _                      ' KG022204
         CALL Trim (WasX$) : _                                       ' KG022204
         ZFileLocation$ = "" : _                                     ' KG022301
         CALL MacroExe (WasX$) : _                                   ' KG022204
         IF ZFileLocation$ = "" THEN _                               ' KG022301
            ZOK = ZFalse : _                                         ' KG022204
            GOTO 58711 _                                             ' KG022301
         ELSE WasX$ = ZFileLocation$                                 ' KG022301
      WasX$ = WasX$ + FilName$                                       ' KG022301
      CALL FindFile (WasX$,ZOK)                                      ' KG022301
      GOTO 58710                                                     ' KG022301
58705 WasX$ = ZLibWorkDiskPath$ + _
           FilName$
      CALL FindIt (WasX$)
      IF ZOK THEN _
         GOTO 58710
      WasX$ = ZLibDrive$ + _
           FilName$
      CALL FindIt (WasX$)
58710 FilName$ = WasX$
58711 CALL SkipLine (-MarkingTime)                                   ' KG021802
      END SUB
58800 ' $SUBTITLE: 'WipeLine - Wipe away a line so next overprints'
' $PAGE
'
'  NAME    -- WipeLine
'
'  INPUTS  --     PARAMETER                    MEANING
'                 ZCarriageReturn$
'                 CharsToWipe            # OF CHARACTERS TO BLANK
'                 ZNulls
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- Wipe away a line and leave cursor at beginning of the
'             same line so that the next line will print in its place
'
      SUB WipeLine (CharsToWipe) STATIC
      IF ZNulls OR CharsToWipe > 79 THEN _
         CALL SkipLine (1) : _
         EXIT SUB
      IF NOT ZLocalUser THEN _
         Strng$ = ZCarriageReturn$ + SPACE$(CharsToWipe) + ZCarriageReturn$ : _
         IF ZFossil THEN _
            Bytes = LEN(Strng$) : _
            CALL FosWrite(ZComPort,Bytes,Strng$) _
         ELSE PRINT #3,Strng$
      IF ZSnoop THEN _
         LOCATE ,1 :  _
         CALL LPrnt(SPACE$(CharsToWipe),0) : _
         LOCATE ,1
      IF ZF7Msg$ = "" OR _
         ZF7Msg$ = "NONE" OR _
         NOT ZSysopNext THEN _
         EXIT SUB
      ZBypassTimeCheck = ZTrue
      CALL BufFile (ZF7Msg$,WasX)
      END SUB
58895 ' $SUBTITLE: 'GetDirs -- Prompt for directories to search'
' $PAGE
'
'  NAME    -- GetDirs
'
'  INPUTS  --     PARAMETER                    MEANING
'                 ZDirPrompt$             BASE OF DIRECTORY PROMPT
'                 ShowHelp               Whether to display help
'                                            on entry
'  OUTPUTS --     ZUserIn$
'                 ZWasQ
'
'  PURPOSE -- Prompt for directories to search
'
      SUB GetDirs (ShowHelp) STATIC
      IF ShowHelp AND (ZAnsIndex >= ZLastIndex ) THEN _
         GOTO 58902
58900 ZOutTxt$ = ZDirPrompt$
      ZMacroMin = 2
      CALL PopCmdStack
      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
         EXIT SUB
      CALL AllCaps (ZUserIn$(ZAnsIndex))
      IF ZUserIn$(ZAnsIndex) = "Q" THEN _
         ZWasQ = 0 : _
         EXIT SUB
      ZWasA = INSTR("E+.E-.E.L.H.?.",ZUserIn$(ZAnsIndex)+".")
      IF ZWasA = 0 THEN _
         EXIT SUB
      IF ZWasA > 8 THEN _
         IF ZAnsIndex < ZLastIndex THEN _
            GOTO 58900 _
         ELSE GOTO 58902
      IF ZWasA = 7 THEN _
         ZExtendedOff = NOT ZExtendedOff _
      ELSE ZExtendedOff = (ZWasA > 3)
      CALL QuickTPut1 ("Extended directory display "+FNOffOn$(NOT ZExtendedOff)) ' DA071801
      GOTO 58900
58902 ZFileName$ = ZCurDirPath$ + ZDirPrefix$ + _
                    "." + ZDirExtension$
      GDefault$ = MID$(" GC",ZWasGR + 1, 1)
      CALL Graphic (GDefault$,ZFileName$)
      CALL BufFile (ZFileName$,ZAnsIndex)
      GOTO 58900
      END SUB
'
58950 ' $SUBTITLE: 'ConvertDir -- Converts coded response to right directory'
' $PAGE
'
'  NAME    -- ConvertDir
'
'  INPUTS  --     PARAMETER                    MEANING
'                 Start               ELEMENT TO BEGIN WITH
'                 ZUserIn$            ARRAY TO CONVERT
'                 ZWasQ               Last ELEMENT TO CONVERT
'
'  OUTPUTS --     ZUserIn$            CONVERTED DIRECTORY LIST
'
'  PURPOSE -- Let the user put in a short standard string for a directory
'
'
      SUB ConvertDir (Start) STATIC
      FOR WasI=Start TO ZLastIndex
         CALL AllCaps (ZUserIn$(WasI))
         IF ZUserIn$(WasI)="U" THEN _
            ZUserIn$(WasI) = ZUpldDirCheck$
         IF ZUserIn$(WasI) = "A" THEN _
            ZUserIn$(WasI) = "ALL"
      NEXT
      END SUB
59100 ' $SUBTITLE: 'Muzak - subroutine to PLAY ZMusic'
' $PAGE
'
'  NAME    -- Muzak
'
'  INPUTS  --   PARAMETER     MEANING
'                       1   PLAY CONSIDER YOURSELF(OPENING SCREEN)
'                       2   PLAY WALK RIGHT IN(NEW USERS)
'                       3   PLAY DRAGNET (SECURITY VIOLATION)
'                       4   PLAY GOODBYE CHARLIE (GOODBYE)
'                       5   PLAY TAPS (ACCESS DENIED)
'                       6   PLAY OOM PAH PAH (DOWNLOAD)
'                       7   PLAY THNKS FOR MEMORIES(UPLOAD)
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- Provide sysops and the visually impaired with
'             auditory feedback on what RBBS-PC is doing
'
      SUB Muzak (PassedArg) STATIC
      ZFF = PassedArg
      ZSubParm = 0
      IF (NOT ZSnoop) OR (NOT ZMusic) OR ZLocalUserMode THEN _
         EXIT SUB
      ON ZFF GOTO 59102,59104,59106,59108,59110,59112,59114
      EXIT SUB
59102 '---[Introduction CONSIDER YOURSELF]---
    Music$ = "MBT180A4B-8B-8B-8B-2.G4A8F2"
    PLAY "O2 X" + VARPTR$(Music$)
    EXIT SUB
59104 '---[New User WALK RIGHT IN]---
    Music1$ = "MBT180G4G4D2G8F+8F8E2A8B8"
    Music2$ = "C8C+8D8C8"
    Music3$ = "B4G2"
    PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
    EXIT SUB
59106 '---[Security Violation DRAGNET THEME]---
     Music$ = "MBT120C2D8E-4C2.C2D8E-4C4G-2."
     PLAY "O2 X" + VARPTR$(Music$)
     EXIT SUB
59108 '---[Goodbye GOODBYE CHARLIE]---
      Music$ = "MBT180B-2.G2.F4D2."
      PLAY "O2 X" + VARPTR$(Music$)
      EXIT SUB
59110 '---[Access Denied TAPS]---
      Music1$ = "MBT90F8A16"
      Music2$ = "C4."
      Music3$ = "A4F4C2.C8C16F2"
      PLAY "O2 X" + VARPTR$(Music1$) + "O3 X" + VARPTR$(Music2$) + "O2 X" + VARPTR$(Music3$)
      EXIT SUB
59112 '---[Download OOM PAH PAH]---
       Music$ = "MBT180F4A4A4C4A4A4G4A4G4D2"
       PLAY "O2 X" + VARPTR$(Music$)
       EXIT SUB
59114 '---[Upload THANKS FOR THE MEMORIES]---
       Music1$ = "MBT180C2."
       Music2$ = "A8G8F4D2"
       PLAY "O3 X" + VARPTR$(Music1$) + "O2 X" + VARPTR$(Music2$)
       END SUB
59200 ' $SUBTITLE: 'TwoByteDate -- subroutine to put date in 2 bytes'
' $PAGE
'
'  NAME    -- TwoByteDate
'
'  INPUTS  --   PARAMETER     MEANING
'                  Year       FOUR DIGIT YEAR (I.E. 1987)
'                  WasMM      MONTH
'                  WasDD      DAY
'                Result$      LOCATION TO PLACE THE Result
'
'  OUTPUTS -- Result$       TWO BYTE COMPRESSED DATE FOR USE IN
'                           A RANDOM RECORD
'
'  PURPOSE -- Compress a WasY,ZMsgPtr,WasD date into two characters
'
      SUB TwoByteDate (Year,WasMM,WasDD,Result$) STATIC
      Result$ = CHR$(((Year - 1980) * 2) OR - ((WasMM AND 8) <> 0)) + _
                CHR$((WasMM AND NOT 8) * 32 + WasDD)
      END SUB
59201 ' $SUBTITLE: 'PackDate -- subroutine to Compress STRING DATE'
' $PAGE
'
'  NAME    -- PackDate
'
'  INPUTS  --   PARAMETER     MEANING
'                 Strng$    String Date (mm-dd-yyyy)
'
'  OUTPUTS --    Result$    TWO BYTE COMPRESSED DATE FOR USE IN
'                                      A RANDOM RECORD
'
'  PURPOSE -- Compress an 8-character date into two characters
'
      SUB PackDate (Strng$,Result$) STATIC
      IF LEN(Strng$) < 8 THEN _
         EXIT SUB
      Year = VAL(MID$(Strng$,7))
      WasMM = VAL(Strng$)
      WasDD = VAL(MID$(Strng$,4))
      CALL TwoByteDate (Year,WasMM,WasDD,Result$)
      END SUB
59202 ' $SUBTITLE: 'UnPackDate -- subroutine to UNCompress DATE'
' $PAGE
'
'  NAME    -- UnPackDate
'
'  INPUTS  --   PARAMETER      MEANING
'             CompressedDate$ Date in 2 byte compressed form
'
'  OUTPUTS --     Year           Year of compressed date
'                 WasMM          Month of compressed date
'                 WasDD          Day of compressed date
'             DisplayDate$       8 char display date (mm-dd-yyyy)
'
'  PURPOSE -- Uncompress a 2 char date to get Y,M,D & display
'
      SUB UnPackDate (CompressedDate$,Year,WasMM,WasDD,DisplayDate$) STATIC
      CALL GetYMD (CompressedDate$,1,Year)
      CALL GetYMD (CompressedDate$,2,WasMM)
      CALL GetYMD (CompressedDate$,3,WasDD)
      DisplayDate$ = RIGHT$("00" + MID$(STR$(WasMM),2),2) + _
                      "-" + _
                      RIGHT$("00" + MID$(STR$(WasDD),2),2) + _
                      "-" + _
                      RIGHT$(STR$(Year),2)
      END SUB
59204 ' $SUBTITLE: 'GetYMD -- subroutine to unpack a two-byte date'
' $PAGE
'
'  NAME    -- GetYMD
'
'  INPUTS  --   PARAMETER     MEANING
'                 TwoByte$    PACKED TWO-BYTE DATE FIELD
'                   YMD       1 = YEAR
'                             2 = MONTH
'                             3 = DAY
'                 Result      LOCATION TO PLACE THE Result
'
'  OUTPUTS -- Result        FOUR DIGIT Result OF UNPAKING THE DATE
'
'  PURPOSE -- Unpack a compressed two-byte date field
'
      SUB GetYMD (TwoByte$,YMD,Result) STATIC
      ON YMD GOTO 59206,59210,59215
      EXIT SUB
59206 Result = (ASC(TwoByte$)AND NOT 1) / 2 + 1980
      EXIT SUB
59210 Result = FIX((ASC(MID$(TwoByte$,2)) / 32)) OR ((ASC(TwoByte$) AND 1) * 8)
      EXIT SUB
59215 Result = ASC(MID$(TwoByte$,2)) AND NOT 224
      END SUB
59300 ' $SUBTITLE: 'PersFile - processes requests for personal files'
' $PAGE
'
'  NAME    -- PersFile
'
'  INPUTS  --     PARAMETER           MEANING
'                 PersonalCat$     CATEGORY IN DIR FOR CALLER
'                 ZPersonalLen      # CHARS IN PERSONAL CATEGORY
'  OUTPUTS -- NONE UP ZDnlds
'
'  PURPOSE -- Show caller what personal files have for downloading,
'             verify and process requests for downloads
'
      SUB PersFile (PersonalCat$,DnldFlag) STATIC
      CALL FindIt (ZPersonalDir$)
59302 IF NOT ZOK THEN _
         CALL QuickTPut1 ("No personal files available") : _
         ZLastIndex = 0 : _
         EXIT SUB
      GOSUB 59338
      IF LOF(2) < WasL THEN _
        ZOK = ZFalse : _
        GOTO 59302
      ZUserIn$(0) = ""
      MaxPrint = ZPageLength - 1
      ZNonStop = ZNonStop OR (ZPageLength < 1)
      ZStopInterrupts = ZFalse
      IF Downloading THEN _
         Downloading = ZFalse : _
         PersIndex = DnldFlag : _
         DnldFlag = 0 : _
         GOTO 59306
59303 CALL QuickTPut (ZEmphasizeOff$,0)                              ' KG030202
      ZOutTxt$ = "Download what: L)ist, * = new, or file(s)" + _
           ZPressEnterExpert$
      ZMacroMin = 99
      ZStackC = ZTrue
      CALL PopCmdStack
      IF ZSubParm = -1 OR ZWasQ = 0 THEN _
         ZLastIndex = 0 : _
         EXIT SUB
59304 SelectedProtocol$ = ""
      IF ZLastIndex > 1 THEN _
         IF LEN(ZUserIn$(ZLastIndex)) = 1 THEN _
            SelectedProtocol$ = ZUserIn$(ZLastIndex) : _
            CALL AllCaps (SelectedProtocol$) : _                     ' KG081501
            IF INSTR(ZDefaultXfer$,SelectedProtocol$) = 0 THEN _     ' KG081501
               SelectedProtocol$ = "" _                              ' KG081501
            ELSE ZLastIndex = ZLastIndex - 1                         ' KG081501
      IF LEN(ZUserIn$(ZAnsIndex)) > 1 THEN _
         GOTO 59330
      CALL AllCaps (ZUserIn$(ZAnsIndex))
      ON INSTR("L*",ZUserIn$(ZAnsIndex)) GOTO 59305,59327
      GOTO 59303
59305 PersIndex = LastRec
      WasL = ZFalse
59306 IF PersIndex < 1 THEN _
         IF WasL THEN _
            GOTO 59303 _
         ELSE _
            ZOutTxt$ = "No files for you" : _
                 CALL QuickTPut1 (ZOutTxt$) : _
              GOTO 59303
      GET #2,PersIndex
      PersIndex = PersIndex - 1
      IF ZSysop THEN _
         GOTO 59320
      IF ASC(PrivateCat$) = 32 THEN _
         IF ZUserSecLevel < VAL(PrivateCat$) THEN _
            GOTO 59306 _
         ELSE GOTO 59308
      IF PersonalCat$ <> PrivateCat$ THEN _
         GOTO 59306
59308 WasL = ZTrue
      FilName$ = ZPersonalDrvPath$ + _
                 LEFT$(PartToPrint$,12)
59320 ZOutTxt$ = PartToPrint$
      IF PersonalStatus$ = "*" AND LEFT$(ZOutTxt$,1) <> " " THEN _
         MID$(ZOutTxt$, INSTR(ZOutTxt$," ")) = "*"                   ' DA080903
      CALL ColorDir (ZOutTxt$,"Y")
      IF ZLocalUser THEN _
         GOTO 59322
      CALL EofComm (Char)
      IF Char <> -1 THEN _
         GOTO 59323            ' comm port input
59322 ZKeyboardStack$ = INKEY$
59323 ZSubParm = 5
      CALL TPut
      IF ZRet THEN _
         GOTO 59303
      IF ZSubParm = -1 THEN _
         GOTO 59335
59324 IF ZLinesPrinted <= MaxPrint THEN _
         GOTO 59306
      CALL TimeRemain (MinsRemaining)
      IF MinsRemaining <= 0 THEN _
         ZSubParm = -1 : _
         GOTO 59335
      CALL Carrier
      IF ZSubParm = -1 THEN _
         GOTO 59335
      IF ZNonStop THEN _
         GOTO 59306
59325 IF PersIndex > 0 THEN _
         ZOutTxt$ = "MORE: [Y],N,C or download what (* = new)" _
      ELSE GOTO 59303
      ZNoAdvance = ZTrue
      ZMacroMin = 99
      ZStackC = ZTrue
      CALL PopCmdStack
      IF ZSubParm = -1 THEN _
         GOTO 59335
      ZNonStop = (ZNonStop OR INSTR(" Cc",ZUserIn$) > 1)
      IF PersIndex < 1 AND ZWasQ = 0 THEN _
         GOTO 59335
      CALL WipeLine (78)
      IF ZNo THEN _
         GOTO 59303
      IF LEN(ZUserIn$(ZAnsIndex)) > 2 THEN _
         GOTO 59304
      GOTO 59306
59327 PersIndex = LastRec        ' handle new files
      ZLastIndex = 0
      WHILE PersIndex > 0 AND  ZLastIndex < UBOUND(ZUserIn$)
         GET 2,PersIndex
         IF PersonalCat$ <> PrivateCat$ THEN _
            GOTO 59329
         IF PersonalStatus$ <> "*" THEN _
            GOTO 59329
         ZLastIndex = ZLastIndex + 1
         WasI = ZLastIndex
         GOSUB 59336
         IF ZOK THEN _
            WasX$ = MID$(STR$(PersIndex),2) : _
            ZUserIn$(0) = ZUserIn$(0) + _
                    WasX$ + _
                    SPACE$(5 - LEN(WasX$)) _
         ELSE ZLastIndex = ZLastIndex - 1
59329    PersIndex = PersIndex - 1
      WEND
      IF ZLastIndex = 0 THEN _
         ZOutTxt$ = "No new files for you" : _
         CALL QuickTPut1 (ZOutTxt$) : _
         GOTO 59303
      ZAnsIndex = 1
      GOTO 59332
59330 WasI = ZAnsIndex              ' handle list of files
      WHILE WasI <= ZLastIndex
         ZOK = ZFalse
         WasJ = LastRec + 1
         CALL AllCaps (ZUserIn$(WasI))
         WasX = INSTR(ZUserIn$(WasI),".")
         IF WasX = 0 THEN _
            ZUserIn$(WasI) = ZUserIn$(WasI) + "." + ZDefaultExtension$ _
         ELSE IF WasX = LEN(ZUserIn$(WasI)) THEN _
                 ZUserIn$(WasI) = LEFT$(ZUserIn$(WasI),WasX-1)
         WHILE WasJ > 1 AND NOT ZOK
            WasJ = WasJ - 1
            GET #2,WasJ
            IF (PersonalCat$ = PrivateCat$ OR _
               (ASC(PrivateCat$) = 32 AND _
                ZUserSecLevel => VAL(PrivateCat$))) THEN _
                   ZOK = (ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1))
         WEND
         IF ZOK THEN _
            GOSUB 59336 : _
            IF ZOK THEN _
               WasX$ = MID$(STR$(WasJ),2) : _
               ZUserIn$(0) = ZUserIn$(0) + _
                       WasX$ + _
                       SPACE$(5 - LEN(WasX$))
         IF NOT ZOK THEN _
            CALL QuickTPut1 (ZUserIn$(WasI) + " not found - omitted") : _
            FOR WasK = WasI + 1 TO ZLastIndex : _
               ZUserIn$(WasK - 1) = ZUserIn$(WasK) : _
            NEXT : _
            ZLastIndex = ZLastIndex - 1 : _
            WasI = WasI - 1
         WasI = WasI + 1
      WEND
      IF ZLastIndex = 0 THEN _
         GOTO 59303
59332 DnldFlag = PersIndex          ' set protocol
      Downloading = ZTrue
      ZWasB = 1
      IF SelectedProtocol$ = "" THEN _
         IF ZPersonalProtocol$ <> " " THEN _
            SelectedProtocol$ = ZPersonalProtocol$
      IF SelectedProtocol$ <> "" THEN _
         ZLastIndex = ZLastIndex + 1 : _
         ZUserIn$(ZLastIndex) = SelectedProtocol$
      EXIT SUB
59335 CLOSE 2
      EXIT SUB
59336 ZUserIn$(WasI) = LEFT$(PartToPrint$,INSTR(PartToPrint$," ") - 1)
      CALL FindFile (ZPersonalDrvPath$ + ZUserIn$(WasI),ZOK)
      IF ZOK THEN _
         ZUserIn$(WasI) = ZPersonalDrvPath$ + ZUserIn$(WasI) _
      ELSE CALL RotorsDir (ZUserIn$(WasI),ZSubDir$(),ZSubDirCount + _
                      ((ZUserSecLevel < ZMinSecToView) OR _
                       NOT ZCanDnldFromUp),ZTrue,"D") : _            ' KG022204
           GOSUB 59338
      RETURN
59338 CLOSE 2
      WasL = 36 + ZMaxDescLen + ZPersonalLen
      IF ZShareIt THEN _
         OPEN ZPersonalDir$ FOR RANDOM SHARED AS #2 LEN=WasL _
      ELSE OPEN "R",2,ZPersonalDir$,WasL
      FIELD #2,33 + ZMaxDescLen AS PartToPrint$, _
               ZPersonalLen    AS PrivateCat$, _
               1               AS PersonalStatus$, _
               2               AS Filler$
      LastRec = LOF(2) / WasL
      RETURN
      END SUB
59400 ' $SUBTITLE: 'LogPDown -- subroutine to record private downloads'
' $PAGE
'
'  NAME    -- LogPDown
'
'  INPUTS  --   PARAMETER     MEANING
'
'  OUTPUTS --
'
'  PURPOSE -- Puts a "!" in place of an "*" in private directory
'             after downloaded
'
      SUB LogPDown (PrivateDnld,DwnIndex) STATIC                     ' RH021501
      IF NOT PrivateDnld THEN _
         EXIT SUB
      ZWasEN$ = ZPersonalDir$
      WasBX = &H4
      ZSubParm = 9
      CALL FileLock
      WasL = 36 + ZMaxDescLen + ZPersonalLen
      CLOSE 2
      IF ZShareIt THEN _
         OPEN ZWasEN$ FOR RANDOM SHARED AS #2 LEN=WasL _
      ELSE OPEN "R",2,ZPersonalDir$,WasL
      FIELD #2,WasL AS PersonalRec$
      FOR Temp = 1 TO ZDownFiles                                     ' KG102702
         ZWasA = VAL(MID$(ZUserIn$(0),5 * (DwnIndex - Temp) + 1,5))  ' KG102702
         GET #2,ZWasA                                                ' KG102702
         MID$(PersonalRec$,WasL-2,1) = "!"                           ' KG102702
         PUT #2,ZWasA                                                ' KG102702
      NEXT                                                           ' KG102702
      CALL UnLockAppend
      END SUB
59450 ' $SUBTITLE: 'UserFace - handles programmable user interface'
' $PAGE
'
'  NAME    --  UserFace
'
'  INPUTS  --  PARAMETER                   MEANING
'              GDefault$            GRAPHICS DEFAULT TO USE
'              ZCurPUI$             PUI TO USE
'              ZExpertUser          WHETHER CALL IN EXPERT MODE
'
'  OUTPUTS --  ZWasQ
'              ZUserIn$()
'              ZWasZ$
'
'  PURPOSE --  When sysop overrides RBBS-PC's default user
'              interface (provides a MAIN.PUT), this routine
'              reads in the table of specifications, presents
'              the sysop menu, presents the prompt, verifies
'              that a valid option has been picked, determines
'              whether the option is another PUI, and passes
'              back choices to be processed.
'
      SUB UserFace (GDefault$) STATIC
59455 IF ZPrevPUI$ = ZCurPUI$ THEN _
         GOTO 59458
59456 ZFileName$ = ZCurPUI$
      CALL Graphic (GDefault$,ZFileName$)
      IF NOT ZOK THEN _
         CALL UpdtCalr ("Missing menu " + ZCurPUI$,2) : _
         ZCurPUI$ = ZPrevPUI$ : _
         GOTO 59456
      ZPrevPUI$ = ZCurPUI$
      LINE INPUT #2,ZFileName$
      LINE INPUT #2,Prompt$
      INPUT #2,ValidChoice$,ActualCommands$
      LINE INPUT #2,MenuChoice$
      LINE INPUT #2,MenuName$
      LINE INPUT #2,QuitCmd$
      LINE INPUT #2,QuitPrompt$
      LINE INPUT #2,QuitSubCmds$
      LINE INPUT #2,QuitMenuOpt$
      LINE INPUT #2,QuitMenus$
      CALL Graphic (GDefault$,ZFileName$)
      CALL BreakFileName (ZFileName$,MenuDrvPath$,WasX$,ZWasY$,ZTrue)
      MenuToDisplay$ = ZFileName$
      WasJ = INSTR(ZOrigCommands$,"?")
      IF WasJ < 1 THEN _
         WasX$ = "" _
      ELSE WasX$ = MID$(ZAllOpts$,WasJ,1)
59458 IF ZExpertUser THEN _
         GOTO 59461
59460 ZNonStop = (ZPageLength < 1)
      CALL BufFile (MenuToDisplay$,WasX)
59461 ZOutTxt$ = Prompt$
      ZTurboKey = -ZTurboKeyUser
      CALL PopCmdStack
      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
         EXIT SUB
      IF ZWasQ = 0 THEN _
         GOTO 59458
59462 ZWasZ$ = ZUserIn$(ZAnsIndex)
      CALL AllCaps (ZWasZ$)
      WasJ = INSTR(ValidChoice$,ZWasZ$)
      IF WasJ < 1 THEN _
         GOTO 59492
      ZWasZ$ = MID$(ActualCommands$,WasJ,1)
      ZUserIn$(ZAnsIndex) = ZWasZ$
      WasJ = INSTR(MenuChoice$,ZWasZ$)
      IF WasJ > 0 THEN _
         ZCurPUI$ = MID$(MenuName$,1 + (WasJ - 1) * 7,7) : _
         GOTO 59490
      IF ZWasZ$ = WasX$ THEN _
         GOTO 59460
      IF ZWasZ$ <> QuitCmd$ THEN _
         EXIT SUB
59470 ZOutTxt$ = QuitPrompt$
      ZTurboKey = -ZTurboKeyUser
      CALL PopCmdStack
      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
         EXIT SUB
      IF ZWasQ = 0 THEN _
         GOTO 59458
59480 ZWasZ$ = ZUserIn$(ZAnsIndex)
      CALL AllCaps (ZWasZ$)
      WasJ = INSTR(QuitSubCmds$,ZWasZ$)
      IF WasJ < 1 THEN _
         GOTO 59470
      WasJ = INSTR(QuitMenuOpt$,ZWasZ$)
      IF WasJ > 0 THEN _ 'quit to submenu
         ZCurPUI$ = MID$(QuitMenus$,1 + (WasJ - 1) * 7,7) : _
         GOTO 59490
      ZUserIn$(ZAnsIndex) = QuitCmd$ 'valid but not menu-send to RBBS
      EXIT SUB
59490 CALL Remove (ZCurPUI$," ")
      ZCurPUI$ = MenuDrvPath$ + _
                     ZCurPUI$ + _
                     ".PUI"
      GOTO 59455
59492 CALL QuickTPut1 ("No such option <" + ZWasZ$ + ">")            ' DA071701
      Call FlushKeys                                                 ' KG081703
      GOTO 59460
      END SUB
59500 ' $SUBTITLE: 'SubMenu -- subroutine to process menus'
' $PAGE
'
'  NAME    -- SubMenu
'
'  INPUTS  --   PARAMETER     MEANING
'             PassedPrompt$   PROMPT TO DISPLAY
'             CurMenu$        NOVICE MENU TO DISPLAY
'             FrontOpt$       DRIVE/PATH/PREFIX OF FILE
'                             NEEDED FOR TYPED OPTION
'             BackOpt$        SUFFIX/EXTENSION OF FILE
'                             NEEDED WITH TYPED OPTION
'             ReturnOn$       LETTERS CALLING PROGRAM WANTS
'                             CONTROL ON
'             GRDefault$      GRAPHICS DEFAULT TO USE
'             VerifyInMenu    WHETHER VERIFY OPTION IS IN MENU
'             AllMenuOK       WHETHER CONTROL SHOULD RETURN
'                             WHEN IN MENU
'             ZAnsIndex       # OF COMMANDS IN TYPE AHEAD
'             RequireInMenu   WHETHER OPTION MUST BE IN MENU
'
'  OUTPUTS -- ZWasZ$              OPTION PICKED
'             ZFileName$      NAME OF FILE SUPPORTING OPTION
'
'
'  PURPOSE -- Handles menus - including conference, bulletins,
'             doors, questionnaires.  Supports sub-menus (i.e.
'             an option on the menu that invokes another menu)
'
      SUB SubMenu (PassedPrompt$,CurMenu$,FrontOpt$, _
                  BackOpt$,ReturnOn$,GRDefault$,PassedVerifyInMenu, _' KG082005
                  AllMenuOK,RequireInMenu,BackOpt2$,InMenu) STATIC   ' KG032502
59510 ZFileName$ = CurMenu$
      InMenu = ZTrue                                                 ' KG041701
      CALL BreakFileName (FrontOpt$,WasX$,FrontPre$,ZWasDF$,ZTrue)   ' KG101101
      CALL BreakFileName (CurMenu$,MenuDrv$,WasX$,ZWasDF$,ZTrue)
      MenuFront$ = MenuDrv$ + LEFT$(WasX$,LEN(WasX$)-LEN(PreSuf$))   ' KG090801
      IF CurMenu$ = LastSubMenu$ THEN _                              ' KG090801
         MenuFront$ = LEFT$(MenuFront$,LEN(MenuFront$)-1)            ' KG090801
      CALL Graphic (GRDefault$,ZFileName$)
      CurMenuVer$ = ZFileName$
      ZStopInterrupts = ZFalse
      IF ZAnsIndex < ZLastIndex OR ZExpertUser THEN _
         GOTO 59520
59515 CALL BufFile (CurMenuVer$,ZAnsIndex) 'show menu
59520 ZOutTxt$ = PassedPrompt$            'get response
      CALL PopCmdStack
      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
         EXIT SUB
59530 ZWasZ$ = ZUserIn$(ZAnsIndex)
      CALL AllCaps (ZWasZ$)
      IF INSTR(ReturnOn$,ZWasZ$) THEN _  'check whether calling pgm wants
         EXIT SUB
      IF INSTR("LH?",ZWasZ$) THEN _       'check whether caller wants help
         GOTO 59515
      IF INSTR(ZWasZ$,".") > 0 THEN _
         GOTO 59532
      CALL BadFile (ZWasZ$,WasBF)                                    ' KG081705
      IF WasBF > 1 THEN _                                            ' KG081705
         GOTO 59532                                                  ' KG081705
      FPre$ = MenuFront$   ' check for sub-option                    ' KG081603
      PreSuf$ = "-"                                                  ' KG090801
      CALL BadFile (FPRE$ + ZWasZ$ + "-",WasBF)                      ' KG090801
      ZOK = ZFalse                                                   ' KG082401
      IF WasBF < 2 THEN _                                            ' KG082401
         VerifyInMenu = ZFalse : _                                   ' KG082401
         GOSUB 59538
      PreSuf$ = ""                                                   ' KG090801
      VerifyInMenu = PassedVerifyInMenu                              ' KG082005
      IF NOT ZOK THEN _                                              ' KG081603
         FPre$ = FrontOpt$ : _    ' check standard option            ' KG081603
         GOSUB 59538 : _
         IF NOT ZOK THEN _    ' check option where menu is           ' KG081603
            FPre$ = MenuDrv$ + FrontPre$ : _                         ' KG101101
            IF FrontOpt$ <> FPre$ THEN _                             ' KG101101
               GOSUB 59538                                           ' KG101101
      IF NewMenu THEN _
         NewMenu = ZFalse : _
         GOTO 59515
      IF ZOK THEN _
         EXIT SUB
59532 IF INSTR(ReturnOn$,LEFT$(ZWasZ$,1)) > 0 THEN _                 ' KG102202
         ZWasZ$ = LEFT$(ZWasZ$,1) : _                                ' KG102202
         EXIT SUB
      GOSUB 59547
      GOTO 59515
59538 FilName$ = FPre$ + ZWasZ$ + PreSuf$                            ' KG090801
      ZFileName$ = FilName$ + BackOpt$                               ' KG090801
      GOSUB 59543                                                    ' KG101201
      IF WasBF > 1 THEN _                                            ' KG101201
         ZOK = ZFalse : _                                            ' KG101201
         RETURN                                                      ' KG101201
      CALL Graphic (GRDefault$,ZFileName$)
      IF NOT ZOK THEN _
         IF BackOpt2$ <> "" THEN _
            ZFileName$ = FilName$ + _
                         BackOpt2$ : _
         GOSUB 59543 : _                                             ' KG101201
         IF WasBF > 1 THEN _                                         ' KG101201
            ZOK = ZFalse : _                                         ' KG101201
            RETURN _                                                 ' KG101201
         ELSE CALL Graphic (GRDefault$,ZFileName$)                   ' KG101201
      IF ZOK THEN _                                                  ' KG092301
         CALL WordInFile (CurMenu$,ZWasZ$,InMenu) : _                ' KG092301
         IF ZSysop OR InMenu OR (NOT RequireInMenu) THEN _           ' KG092301
            RETURN _
         ELSE GOTO 59540
      IF (NOT VerifyInMenu) THEN _
         GOTO 59540
      CALL WordInFile (CurMenu$,ZWasZ$,InMenu)  'verify against menu itself ' KG032502
      IF InMenu THEN _                                               ' KG032502
         IF AllMenuOK THEN _
            RETURN
59540 WasX$ = FPre$ + _
           ZWasZ$ + PreSuf$ + _                                      ' KG090801
           ".MNU" 'check whether option is a menu
      ZFileName$ = WasX$
      CALL Graphic (GRDefault$,ZFileName$)
      IF ZOK THEN _
         NewMenu = ZTrue : _
         CurMenuVer$ = ZFileName$ : _
         CurMenu$ = WasX$ : _
         CALL BreakFileName (FPre$ + ZWasZ$,MenuDrv$,WasX$,ZWasDF$,ZTrue) : _ ' KG090801
         MenuFront$ = MenuDrv$ + WasX$ : _                           ' KG090801
         IF PreSuf$ = "-" THEN _                                     ' KG090801
            LastSubMenu$ = CurMenu$                                  ' KG090801
      RETURN
59543 WasZ$ = ZWasZ$                                                 ' KG101201
      CALL BadName (WasBF,ZFalse)                                    ' KG101201
      ZWasZ$ = WasZ$                                                 ' KG101201
      RETURN                                                         ' KG101201
59547 CALL QuickTPut1 ("No such option " + ZWasZ$)
      ZLastIndex = 0
      IF VerifyInMenu AND InMenu AND NOT RequireInMenu THEN _        ' KG082005
         CALL UpdtCalr("Option " + ZWasZ$ + " on menu " + _          ' KG082005
                       CurMenu$ + " but not found",1)                ' KG082005
      RETURN
59548 END SUB
59600 ' $SUBTITLE: 'SetEcho -- subroutine to reset who echoes'
' $PAGE
'
'  NAME    -- SetEcho
'
'  INPUTS  --   PARAMETER     MEANING
'               NewEcho$   The new echo option
'               ZLocalUser
'
'  OUTPUTS -- ZRemoteEcho   Whether RBBS is to echo what a
'                           remote caller types
'
'  PURPOSE -- Resets who echos.  "R" is for RBBS to echo.
'             "I" is for intermediate host to echo.
'             "C" is for caller's communication pgm to echo.
'
      SUB SetEcho (NewEcho$) STATIC
      IF NewEcho$ = PrevEcho$ THEN _
         EXIT SUB
      IF NewEcho$ = "R" THEN _
         ZRemoteEcho = (NOT ZLocalUser) _
      ELSE ZRemoteEcho = ZFalse
      IF ZLocalUser THEN _
         GOTO 59602
      IF NewEcho$ = "I" THEN _
          IF ZFossil THEN _
             Bytes = LEN(ZHostEchoOn$) : _
             CALL FosWrite(ZComPort,Bytes,ZHostEchoOn$) : _
             GOTO 59602 _
          ELSE PRINT #3,ZHostEchoOn$; : _
               GOTO 59602
      IF PrevEcho$ = "I" THEN _
          IF ZFossil THEN _
             Bytes = LEN(ZHostEchoOff$) : _
             CALL FosWrite(ZComPort,Bytes,ZHostEchoOff$) _
          ELSE PRINT #3,ZHostEchoOff$;
59602 PrevEcho$ = NewEcho$
      END SUB
59698 ' $SUBTITLE: 'MsgImport -- subroutine to import a message'
' $PAGE
'
'  NAME    -- MsgImport
'
'  INPUTS  --   PARAMETER     MEANING
'               MaxLines     MAXIMUM # OF LINES
'               MaxLen       MAXIMUM LENGTH OF A LINE
'               NumLines     NUMBER OF LINES ALREADY IN MESSAGE
'               LineAra$     ARRAY OF LINES IN MESSAGE
'
'  OUTPUTS --   NumLines
'               LineAra$
'
'  PURPOSE -- Allows local user to append a text file to
'             a message.   Will word wrap if needed.
'
      SUB MsgImport (MaxLines,MaxLen,NumLines,LineAra$(1)) STATIC
      IF NOT (ZLocalUser OR ZSysop) THEN _
         CALL QuickTPut1 ("Only for SYSOPS/local users") : _
         EXIT SUB
59700 ZOutTxt$ = "Import what file" + ZPressEnter$
      CALL PopCmdStack
      IF ZSubParm = -1 OR ZWasQ = 0 THEN _
         EXIT SUB
      CALL FindIt (ZUserIn$(ZAnsIndex))
      IF NOT ZOK THEN _
         CALL QuickTPut1 (ZUserIn$(ZAnsIndex) + " not found") : _
         GOTO 59700
      WHILE NOT EOF(2) AND NumLines < MaxLines
         NumLines = NumLines + 1
         LINE INPUT #2,LineAra$(NumLines)
      WEND
      CLOSE 2
      CALL WordWrap (MaxLen,NumLines,LineAra$())
      END SUB
59703 ' $SUBTITLE: 'WordWrap -- subroutine to wrap lines in a message'
' $PAGE
'
'  NAME    -- WordWrap
'
'  INPUTS  --   PARAMETER     MEANING
'               MaxLen       MAXIMUM LENGTH OF A SINGLE LINE
'               NumLines     NUMBER OF LINES IN A MESSAGE
'               LineAra$     ALL THE LINES IN THE MESSAGE
'
'  OUTPUTS --   NumLines
'               LineAra$
'
'  PURPOSE -- Batch adjusts a message, wrapping lines if
'             needed.  Preserves paragraph structure.
'
      SUB WordWrap (MaxLen,NumLines,LineAra$(1)) STATIC
      WasJ = 1
      WHILE WasJ <= NumLines
         ReFormatted = ZFalse
59704    CALL TrimTrail (LineAra$(WasJ)," ")
         WasK = LEN(LineAra$(WasJ))
         IF WasK <= MaxLen THEN _
            GOTO 59705
         CALL FindLast (LineAra$(WasJ)," ",LastPos,HowMany)
         CALL AnyBut (LineAra$(WasJ),1,">",WasX)
         CALL AnyBut (LineAra$(WasJ+1),1,">",Temp)
         IF LEFT$(LineAra$(WasJ + 1),2) = "  " OR ((Temp > 0) AND WasX <> Temp) THEN _
            FOR WasK = NumLines TO WasJ + 1 STEP -1 : _
               LineAra$(WasK + 1) = LineAra$(WasK) : _
            NEXT : _
            NumLines = NumLines + 1 : _
            LineAra$(WasJ + 1) = ""
         IF WasX > 1 THEN _
            IF MID$(LineAra$(WasJ),WasX,1) = " " THEN _
               WasX = WasX + 1
         WasX$ = LEFT$(LineAra$(WasJ),WasX-1)
         IF LastPos < 1 THEN _
            LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),MaxLen) + MID$(LineAra$(WasJ + 1),WasX) : _
            LineAra$(WasJ) = LEFT$(LineAra$(WasJ),MaxLen - 1) + "-" _
         ELSE ZUserIn$ = LEFT$(" ", - (LEN(LineAra$(WasJ + 1)) > 0)) : _
              LineAra$(WasJ + 1) = WasX$ + MID$(LineAra$(WasJ),LastPos + 1) + ZUserIn$ + MID$(LineAra$(WasJ + 1),WasX) : _
              LineAra$(WasJ) = LEFT$(LineAra$(WasJ),LastPos - 1)
         ReFormatted = ZTrue
         GOTO 59704
59705    IF ReFormatted THEN _
            IF WasJ = NumLines THEN _
               NumLines = NumLines + 1
         WasJ = WasJ + 1
      WEND
      END SUB
59760 ' $SUBTITLE: 'AnyBut -- subroutine to find where a word begins'
' $PAGE
'
'  NAME    -- AnyBut
'
'  INPUTS  --   PARAMETER     MEANING
'               Strng$        STRING TO SEARCH FOR WORDS
'               Beg           BYTE POSITION IN Strng$ TO
'                             BEGIN SEARCHING
'               SkipChars$    CHARACTERS TO SKIP OVER WHEN
'                                SEARCHING
'
'  OUTPUTS --   WhereIs      BYTES POSITION IN Strng$ WHERE
'                             WORD BEGINS
'
'  PURPOSE -- Parser.   Finds where a "word" begins, where
'             any character will be accepted as the beginning of a
'             word except those listed in SKIP.CHAR$
'
      SUB AnyBut (Strng$, Beg, SkipChars$, WhereIs) STATIC
      WasX$ = Strng$ + _
           CHR$(0)
      WhereIs = Beg
      IF WhereIs < 1 THEN _
         WhereIs = 1
      WHILE INSTR(SkipChars$, MID$(WasX$, WhereIs, 1)) > 0
         WhereIs = WhereIs + 1
      WEND
      IF WhereIs > LEN(Strng$) THEN _
         WhereIs = 0
      END SUB
59770 ' $SUBTITLE: 'FindEnd -- subroutine to find where a word ends'
' $PAGE
'
'  NAME    -- FindEnd
'
'  INPUTS  --   PARAMETER     MEANING
'               Strng$        STRING TO SEARCH FOR WORDS
'               Beg          POSITION IN Strng$ TO BEGIN SEARCH
'               StopWith$    CHARACTERS THAT TERMINATE A WORD
'
'  OUTPUTS      WhereIs      POSITION IN Strng$ WHERE WORD ENDS
'                             (I.E. THE Last CHARACTER OF THE WORD)
'
'  PURPOSE -- Parser.   Finds where a "word" ends, where
'             any character will be counted as in a word
'             except for those in StopWith$ or when the end of
'             the string is found.
'
      SUB FindEnd (Strng$, Beg, StopWith$, WhereIs) STATIC
      ZWasB = Beg
      IF ZWasB < 1 THEN _
         ZWasB = 1
      IF ZWasB > LEN(Strng$) THEN _
         WasX$ = StopWith$ _
      ELSE WasX$ = MID$(Strng$, ZWasB) + _
                StopWith$
      WasI = 1
      WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
      WHILE WasX = 0
         WasI = WasI + 1
         WasX = INSTR(StopWith$, MID$(WasX$, WasI, 1))
      WEND
      WhereIs = WasI - 1 + ZWasB - 1
      END SUB
59780 ' $SUBTITLE: 'GetAll -- subroutine to create directory list'
' $PAGE
'
'  NAME    -- GetAll
'
'  INPUTS  --   PARAMETER     MEANING
'               LookIn$       NAME OF FILE TO SEARCH
'               DIR.EXT$      MAIN DIRECTORY EXTENSION TO USE
'               StartPos      Last POSITION USED IN ARRAY
'
'  OUTPUTS      StartPos     Last ELEMENT USED IN ARRAY
'               LoadInto$    ARRAY TO LOAD ELEMENTS Found
'
'  PURPOSE -- Creates a list (LoadInto$) of all directories
'             to be listed when ZWasA)ll is selected for a directory.
'             All uses config parm, which can be either a single
'             directory or list of directories (begin with "@").
'
      SUB GetAll (LoadInto$(1), StartPos) STATIC
      IF ZMasterDirName$ <> "" AND LEFT$(ZMasterDirName$,1) <> "@" THEN _
         StartPos = StartPos + 1 : _
         LoadInto$(StartPos) = ZMasterDirName$ : _
         EXIT SUB
      ZOK = ZFalse
      IF LEN (ZMasterDirName$) > 1 AND LEFT$(ZMasterDirName$,1) = "@" THEN _
         CALL FindIt(MID$(ZMasterDirName$,2))
      IF NOT ZOK THEN _
         CALL QuickTPut1 ("No dirs defined for A)ll") : _
         EXIT SUB
      MaxLoad = UBOUND(LoadInto$, 1)
      StartSort = StartPos + 1
      WHILE NOT EOF(2) AND StartPos < MaxLoad
         LINE INPUT #2, ZOutTxt$
         StartPos = StartPos + 1
         LoadInto$(StartPos) = ZOutTxt$
      WEND
      CLOSE 2
      END SUB
59800 ' $SUBTITLE: 'BadFileChar -- checks file for illegal char'
' $PAGE
'
'  NAME    --  BadFileChar
'
'  INPUTS  --  PARAMETER         MEANING
'               FilName$         NAME OF FILE TO CHECK
'
'  OUTPUTS --  IsOK            WHETHER NAME OK
'
'  PURPOSE --  Part of test for file's existence.  If bad
'              character in name, can't exist.
'
      SUB BadFileChar (FilName$,IsOK) STATIC
      WasL = LEN(FilName$)
      IF WasL > 2 THEN _
         IF INSTR(3,FilName$,":") > 0 THEN _
            IsOK = ZFalse : _
            EXIT SUB
      WasX$ = FilName$ + "="
      WasI = 1
      WHILE INSTR("/[]|<>+=;, ?*",MID$(WasX$,WasI,1)) = 0 AND ASC(MID$(WasX$,WasI)) < 128
         WasI = WasI + 1
      WEND
      IsOK = WasI > WasL
      END SUB
'
59850 ' $SUBTITLE: 'ConfMail -- quickly checks mail waiting'
' $PAGE
'
'  NAME    -- ConfMail
'
'  INPUTS  -- PARAMETER        MEANING
'         SKIP.CONFIRM         Whether to skip confirm of option
'         ZConfMailList$       File of user/message pairs to check
'         ZActiveUserFile$     Active user file (restored on exit)
'         ZActiveMessageFile$  Active msg file (restored)
'  OUTPUTS -- None
'
'  PURPOSE -- Quicking scans message header record to get
'             last msg # and user record to get whether any
'             new mail and last msg read, reports both, using
'             highlighting if new mail to caller.
'
      SUB ConfMail (MailCheckConfirm) STATIC
      SkipJoinUnjoin = ZNonStop
      IF ZStartHash = 1 AND ZUserFileIndex > 0 THEN _
         CALL FindIt (ZConfMailList$) _
      ELSE ZOK = ZFalse
      IF NOT ZOK THEN _
         EXIT SUB
      IF PrevMailList$ <> ZConfMailList$ THEN _                      ' KG072101
         SkipParms = 0                                               ' KG072101
      PrevMailList$ = ZConfMailList$                                 ' KG072101
      IF MailCheckConfirm THEN _
         ZOutTxt$ = "Check conferences for mail ([Y],N)" : _
         ZTurboKey = -ZTurboKeyUser : _
         CALL PopCmdStack : _
         IF ZNo OR ZSubParm < 0 THEN _
            EXIT SUB
      CALL BreakFileName (ZActiveUserFile$,WasX$,NowInPre$,NowInExt$,ZFalse)
      CALL BreakFileName (ZOrigUserFile$,WasX$,OrigPre$,OrigExt$,ZFalse)
      CALL SkipLine (1)
      CALL QuickTPut1 ("Checking Message Bases...")                  ' DA071701
      AnyMail = ZFalse
      ZStopInterrupts = ZFalse
      WasA1$ = ZActiveUserFile$
      MsgFileSave$ = ZActiveMessageFile$
      TempIndivValue$ = ""
      UserFileIndexSave = ZUserFileIndex
      UserRecordHold$ = ZUserRecord$
      ZOK = ZTrue
      CALL ReadParms (ZWorkAra$(),1,SkipParms)                       ' KG072101
      IF SkipParms = 0 THEN _                                        ' KG072101
         LogicalEOF$ = "" _                                          ' KG072101
      ELSE LogicalEOF$ = ZWorkAra$(1)                                ' KG072101
59852 IF NOT ZOK THEN _
         GOTO 59854 _                                                ' KG072101
      ELSE IF EOF(2) THEN _                                          ' KG072101
              IF LogicalEOF$ = "" OR SkipParms = 0 THEN _            ' KG073104
                 GOTO 59854 _                                        ' KG072101
              ELSE CALL FindIt (ZConfMailList$) : _                  ' KG072101
                   SkipParms = 0 : _                                 ' KG072901
                   GOTO 59852                                        ' KG072101
         CALL ReadAny
         ZActiveUserFile$ = ZOutTxt$
         CALL ReadAny
         IF ZErrCode > 0 THEN _
            GOTO 59854
         SkipParms = SkipParms + 2                                   ' KG080701
         ZActiveMessageFile$ = ZOutTxt$                              ' KG072901
         CALL FindFile (ZActiveUserFile$,ZOK)
         IF NOT ZOK THEN _
            GOTO 59854
         CALL OpenUser (HighestUserRecord)
         FIELD 5, 128 AS ZUserRecord$
         CALL FindFile (ZActiveMessageFile$,ZOK)
         IF NOT ZOK THEN _
            GOTO 59854
         CALL FindUser (ZOrigUserName$,"",ZStartHash,ZLenHash,_
                        0,0,HighestUserRecord,_
                        Found,HoldUserFileIndex,ZWasSL)
         IF NOT Found THEN _
            GOTO 59853                                               ' KG080701
         CALL OpenMsg
         FIELD 1, 128 AS ZMsgRec$
         GET 1,1
         AnyMail = ZTrue
         WasX = CVI(MID$(ZUserRecord$,57,2))
         WasX = (WasX AND 512) > 0
         CALL BreakFileName (ZActiveUserFile$,WasX$,CurPre$,CurExt$,ZFalse)
         InCur = (CurPre$ = NowInPre$ AND CurExt$ = NowInExt$)
         IF InCur THEN _
            WasX = ZMailWaiting : _                                  ' KG030101
            ZWasA = ZLastMsgRead _
         ELSE ZWasA = CVI(MID$(ZUserRecord$,51,2))
         ZWasB = VAL(LEFT$(ZMsgRec$,8))
         WasZ = (ZWasB - ZWasA)
         IF WasZ < 0 THEN _
            ZWasA = 0 : _
            WasZ = ZWasB _
         ELSE IF WasZ = 0 THEN _
                 WasX = ZFalse
         ZOutTxt$ = MID$(STR$((ZWasB > ZWasA) * WasZ),2)
         ZWasSL = LEN(ZOutTxt$)
         ZOutTxt$ = SPACE$(-(ZWasSL<4) * (4-ZWasSL)) + ZOutTxt$
         ZWasSL = LEN(CurPre$)
         IF CurPre$ = "USERS" AND CurExt$ = "" THEN _
            Conf$ = "MAIN" _
         ELSE Conf$ = LEFT$(CurPre$,ZWasSL-1)
         ZWasY$ = Conf$ + SPACE$(-(ZWasSL<8) * (8-ZWasSL))
         IF WasX THEN _
            WasX$ = ZEmphasizeOn$ + "*Some* to you" + ZEmphasizeOff$ _ ' KG081405
         ELSE WasX$ = ""                                             ' KG081405
         ZOutTxt$ = ZWasY$ + ": " + ZOutTxt$ + " new message(s) " + _ ' KG081405
              WasX$                                                  ' KG081405
         ZSubParm = 5
         CALL TPut
         ZJumpSupported = ZFalse                                     ' DA080901
         IF SkipJoinUnjoin THEN _
            CALL AskMore ("",ZTrue,ZTrue,WasX,ZTrue) : _
            GOTO 59853                                               ' KG080701
         ZTurboKey = -ZTurboKeyUser
         CALL AskMore (",J)oin,U)njoin",ZTrue,ZFalse,WasX,ZFalse)
         IF ZNo THEN _
            GOTO 59854
         WasX$ = LEFT$(ZUserIn$(1),1)
         CALL AllCaps (WasX$)
         IF WasX$ = "J" THEN _
            ZHomeConf$ = Conf$ : _
            GOTO 59854
         IF WasX$ = "U" THEN _
            IF InCur OR (OrigPre$ = CurPre$ AND OrigExt$ = CurExt$) THEN _
               CALL QuickTPut1 ("Can't omit yourself from the board or conference you're in") _
            ELSE LSET ZUserRecord$ = CHR$(0) + "deleted user" : _
                 ZUserFileIndex = HoldUserFileIndex : _
                 ZSubParm = 6 : _
                 CALL FileLock : _
                 PUT 5, HoldUserFileIndex : _
                 ZSubParm = 8 : _
                 CALL FileLock : _
                 CALL QuickTPut1 ("Omitted you from " + Conf$)       ' KG073104
59853 IF ZActiveMessageFile$ = LogicalEOF$ THEN _                    ' KG073104
         GOTO 59854                                                  ' KG073104
      IF NOT ZRet THEN _                                             ' KG073104
         GOTO 59852                                                  ' KG080701
59854 ZActiveUserFile$ = WasA1$
      CALL OpenUser (HighestUserRecord)
      FIELD 5, 128 AS ZUserRecord$
      IF (NOT ZRet) AND NOT AnyMail THEN _
         CALL QuickTPut1 ("You have not joined any conferences")
      ZUserFileIndex = UserFileIndexSave
      LSET ZUserRecord$ = UserRecordHold$
      ZActiveMessageFile$ = MsgFileSave$
      CALL OpenMsg
      FIELD 1, 128 AS ZMsgRec$
      GET 1,1
      ZNonStop = (ZPageLength > 0)
      WasX$ = ZUserIn$(ZAnsIndex+1)                                  ' KG071202
      CALL AllCaps (WasX$)                                           ' KG071202
      ZAnsIndex = ZAnsIndex - (WasX$ = "C")                          ' KG071202
      SkipParms = -(NOT EOF(2))*SkipParms                            ' KG072101
      END SUB
59858 ' $SUBTITLE: 'AskMore -- pauses when possible screen full'
' $PAGE
'
'  NAME    -- AskMore
'
'  INPUTS  --   PARAMETER     MEANING
'               ExtraPrompt$  STRING TO ADD TO MORE PROMPT AT END
'               OverWrite     WHETHER TO WIPE AWAY PROMPT
'
'  OUTPUTS --   ZUserIn$()
'               ZNo
'
'  PURPOSE -- Determines whether need to pause if screen full.
'             And, if so, asks the appropriate question.  If non-
'             stop, at least check for carrier present.
'
      SUB AskMore (ExtraPrompt$, OverWrite, CheckLines,AbortIndex,CantInterrupt) STATIC
      ZNo = ZFalse
      IF CheckLines THEN _
         WasX = -ZDisplayAsUnit*ZUnitCount -(NOT ZDisplayAsUnit)*ZLinesPrinted : _
         IF WasX < ZPageLength OR (ZPageLength = 0) THEN _
            ZWasQ = 0 : _
            EXIT SUB
      IF ZOneStop THEN _
         ZOneStop = ZFalse : _
         ZNonStop = ZTrue : _
         GOTO 59860
      IF ZNonStop THEN _
         ZLinesPrinted = 0 : _
         CALL CheckCarrier : _
         IF ZKeyboardStack$ = "" AND ZCommPortStack$ = "" THEN _
            EXIT SUB _
         ELSE ZNonStop = ZFalse
59860 CALL QuickTPut (ZEmphasizeOff$,0)
      IF CantInterrupt THEN _
         ZTurboKey = 2 : _
         ZForceKeyboard = ZTrue : _
         ZOutTxt$ = "Press Any Key to continue" _
      ELSE GOSUB 59870 : _
           ZOutTxt$ = ZMorePrompt$ + Temp$ + ExtraPrompt$ + LEFT$(">",-ZExpertUser)
      WasX = LEN(ZOutTxt$) + 2
      ZNoAdvance = OverWrite
      ZSubParm = 1
      IF ExtraPrompt$ = "" AND ZTurboKey = 0 THEN _
         ZTurboKey = -ZTurboKeyUser
      ZMacroMin = 2
      CALL TGet
      IF ZSubParm = -1 THEN _
        EXIT SUB
      ZTurboKey = ZFalse
      ZWasDF$ = ZUserIn$ (1)
      CALL AllCaps (ZWasDF$)
      WasI = INSTR(";C;A;",";"+ZWasDF$+";")
      IF WasI = 1 THEN _
         ZNonStop = ZTrue : _
         ZWasQ = 0
      CALL WipeLine (WasX + LEN(ZUserIn$))
      IF NOT ZHiLiteOff THEN _
         CALL QuickTPut (ZLastSmartColor$,0)
      IF CantInterrupt THEN _
         ZNo = ZFalse : _
         EXIT SUB
      IF WasI = 3 THEN _
         AbortIndex = 32000
      IF ZNo THEN _
         ZKeyboardStack$ = "" : _
         ZCommPortStack$ = "" : _
         ZLastSmartColor$ = ""
      IF NOT ZJumpSupported THEN _
         EXIT SUB
      IF ZWasDF$ = "J" THEN _
         IF ZWasQ > 1 THEN _
            ZUserIn$ = ZUserIn$(2) : _
            GOTO 59866 _
         ELSE ZOutTxt$ = "Jump to what text" + ZPressEnterExpert$ : _
              CALL PopCmdStack : _
              IF ZWasQ = 0 THEN _
                 EXIT SUB _
              ELSE GOTO 59866
      IF ZWasDF$ <> "R" THEN _
         EXIT SUB
      ZUserIn$ = ZJumpLast$
59866 ZJumpTo$ = ZUserIn$
      CALL AllCaps (ZJumpTo$)
      ZJumpSearching = ZTrue
      ZJumpLast$ = ZJumpTo$
      EXIT SUB
59870 Temp$ = ""
      IF NOT ZJumpSupported THEN _
         RETURN
      IF ZJumpLast$ = "" THEN _
         Temp$ = LEFT$(",J)ump",2+4*(ZExpertUser+1)) _
      ELSE IF ZExpertUser THEN _
              Temp$ = ",J,R=" + ZJumpLast$ _
           ELSE Temp$ = ",J)ump,R)ejump=" + ZJumpLast$
      RETURN
      END SUB
59880 ' $SUBTITLE: 'CompDate -- subroutine to compute elased days'
' $PAGE
'
'  NAME    -- CompDate
'
'  INPUTS  --   PARAMETER     MEANING
'                   Year        YEAR
'                   WasMM       MONTH
'                   WasDD       DAY
'                 Result!    LOCATION TO PLACE THE Result
'
'  OUTPUTS -- Result!        COMPUTE COMPUTATIONAL DATE
'
'  PURPOSE -- Computes a computational date from YEAR, MONTH, DAY.
'             Results may be used to compute the number of elapsed
'             days between two dates.  You may pass a 2 or 4 digit
'             year, but for meaningful results, be consistent
'
      SUB CompDate (Year,WasMM,WasDD,Result!) STATIC
      IF WasMM < 1 OR WasMM > 12 THEN _
         WasMM = 1
      Result! = Year * 365.0 + _
                INT((Year - 1) / 4) + _
                (WasMM - 1) * 28 + _
                VAL(MID$("000303060811131619212426",(WasMM - 1) * 2 + 1,2)) - _
                ((WasMM > 2) AND ((Year MOD 4) = 0)) + _
                WasDD
      END SUB
59890 ' $SUBTITLE: 'ExpireDate -- subroutine to display expiration date'
' $PAGE
'
'  NAME    -- ExpireDate
'
'  INPUTS  --   PARAMETER           MEANING
'             RegDate!    COMPUTATIONAL REGISTRATION DATE
'             RegPeriod   DAYS IN REGISTRATION PERIOD
'
'  OUTPUTS -- ExpDate$             DISPLAYABLE EXPIRATION DATE
'
'  PURPOSE -- Computes/creates a displayable registration
'             expiration date using registration date and days in
'             registration period.
'
      SUB ExpireDate (RegDate!,RegPeriod,ExpDate$) STATIC
      ExpDate! = RegDate! + RegPeriod
      ExpireYear = INT((ExpDate! - ExpDate! / 1461) / 365)
      ExpireDay = ExpDate! - (ExpireYear * 365.0 + INT((ExpireYear -1)/4))
      ExpireMonth = -((ExpireYear MOD 4)<>0) * _
                      (1 - (ExpireDay > 31) - (ExpireDay > 59) - _
                      (ExpireDay > 90) - (ExpireDay >120) - _
                      (ExpireDay > 151) - (ExpireDay > 181) - _
                      (ExpireDay > 212) - (ExpireDay > 243) - _
                      (ExpireDay > 273) - (ExpireDay > 304) - _
                      (ExpireDay > 334)) - ((ExpireYear MOD 4) = 0) * _
                      (1 - (ExpireDay > 31) - (ExpireDay > 60) - _
                      (ExpireDay > 91) - (ExpireDay >121) - _
                      (ExpireDay > 152) - (ExpireDay > 182) - _
                      (ExpireDay > 213) - (ExpireDay > 243) - _
                      (ExpireDay > 274) - (ExpireDay > 305) - _
                      (ExpireDay > 335))
      ExpireDay = (ExpireDay - ((ExpireMonth - 1) * 28 + _
         VAL(MID$("000303060811131619212426",(ExpireMonth -1) * 2 + 1,2)))) + _
         ((ExpireMonth > 2) AND ((ExpireYear MOD 4) = 0))
      ExpDate$ = RIGHT$("0" + MID$(STR$(ExpireMonth),2),2) + _
                  "/" + _
                  RIGHT$("0" + MID$(STR$(ExpireDay),2),2) + _
                  "/" + _
                  RIGHT$(STR$(ExpireYear),2)
      END SUB
59920 ' $SUBTITLE: 'ColorDir - builds a color FMS directory string'
' $PAGE
'
'  NAME    --  ColorDir
'
'  INPUTS  --  PARAMETER                   MEANING
'               Strng$              String to alter
'               FMSDir$            "Y" FOR FMS DIR
'                                  "N" FOR PERSONAL Download
'
      SUB ColorDir (Strng$,FMSDir$) STATIC
      IF ZWasGR < 2 THEN _
         EXIT SUB
      IF FMSDir$ = "N" THEN _
         GOTO 59921
'
' INSERT COLOR FOR FILENAME
'
      ON INSTR("\ *",LEFT$(Strng$,1)) GOTO 59924,59922,59923
59921 Strng$ = ZDR1$ + LEFT$(Strng$,13) + ZDR2$ + MID$(Strng$,14,10) + _
               ZDR3$ + MID$(Strng$,24,10) + ZDR4$ + MID$(Strng$,34,ZMaxDescLen)
      EXIT SUB
59922 Strng$ = ZDR4$ + Strng$
      EXIT SUB
59923 Strng$ = ZEmphasizeOff$ + Strng$
59924 END SUB
59930 ' $SUBTITLE: 'CheckColor - highlights based on search string'
' $PAGE
'
'  NAME    --  CheckColor
'
'  INPUTS  --  PARAMETER                   MEANING
'              LookFor$           String that triggers highlight
'              LookIn$            String being searched
'              EndColor$          Terminating color
'
'  OUTPUTS --  Strng$              Revised string
'
'  PURPOSE --  Adds highlighting to a string within a string.
'              Respects previous colorization.
      SUB CheckColor (LookIn$,LookFor$,PassedEndColor$) STATIC
      IF LookFor$ = "" THEN _
         EXIT SUB
      WasX$ = LookIn$
      CALL AllCaps (WasX$)
      StartColor = INSTR(WasX$,LookFor$)
      IF StartColor < 1 THEN _
         EXIT SUB
      EndColor$ = PassedEndColor$
      IF EndColor$ = "" THEN _
         EndColor$ = ZEmphasizeOff$ : _
         CALL FindLast (LEFT$(LookIn$,StartColor-1),ZEscape$,WhereFound,WasJ) : _
         IF WhereFound > 0 THEN _
            WasJ = INSTR(WhereFound,LookIn$,"m") : _
            IF WasJ > 0 THEN _
               EndColor$ = MID$(LookIn$,WhereFound,WasJ-WhereFound+1)
      CALL Bracket (LookIn$,StartColor,StartColor + LEN(LookFor$)-1,ZEmphasizeOn$,EndColor$)
      END SUB
59934 ' $SUBTITLE: 'SetHiLite - subroutine to reset highlight preference'
' $PAGE
'
'  NAME    --  SetHiLite
'
'  INPUTS  --  PARAMETER                   MEANING
'              SetTo              New value (True or False)
'              ZEmphasizeOnDef$   String turns emphasize on
'              ZEmphasizeOffDef$  String turns emphasize off
'
'  OUTPUTS --  ZHiLiteOff       Callers preference on Hilite
'              ZEmphasizeOn$       String to use for emphasis
'              ZEmphasizeOff$      String to use after emphasis
'
      SUB SetHiLite (SetTo) STATIC
      ZHiLiteOff = (ZEmphasizeOnDef$ <> "" AND SetTo)
      IF ZHiLiteOff THEN _
         ZEmphasizeOn$ = "" : _
         ZEmphasizeOff$ = "" : _
         ZFG1$ = "" : _
         ZFG2$ = "" : _
         ZFG3$ = "" : _
         ZFG4$ = "" _
      ELSE ZEmphasizeOn$ = ZEmphasizeOnDef$ : _
           ZFG1$ = ZFG1Def$ : _
           ZFG2$ = ZFG2Def$ : _
           ZFG3$ = ZFG3Def$ : _
           ZFG4$ = ZFG4Def$
      END SUB
59940 ' $SUBTITLE: 'ColorPrompt - subroutine to colorize prompts'
' $PAGE
'
'  NAME    --  ColorPrompt
'
'  INPUTS  --  PARAMETER                   MEANING
'              Strng$              String to colorize
'              ZHiLiteOff          Whether highlighting is off
'              ZEmphasizeOn$       String to use for emphasis
'              ZEmphasizeOff$      String to use after emphasis
'
'  OUTPUTS --  Strng$              Colorized string
'
'  PURPOSE -- colorizes a string based on sysop settings
'             and the string.
'                        [...] is the default - put in emphasis
'                        <...> options to type - put in ZFG4$
'                        and first two preceeding words use ZFG1$ and ZFG2$
'                        options identified on right by ) and on
'                        left by space or comma - put in ZFG4$
'
      SUB ColorPrompt (Strng$) STATIC
      IF ZHiLiteOff THEN _
         EXIT SUB
      AlreadyColorized = (INSTR(Strng$,ZEscape$) > 0)
      WasX = INSTR(Strng$,"<")
      IF WasX > 0 THEN _
         GOTO 59943
      WasX = INSTR(Strng$,"[")   ' highlight default
      IF WasX > 0 THEN _
         WasY = INSTR(WasX,Strng$,"]") : _
         IF WasY > 0 THEN _
            CALL Bracket (Strng$,WasX,WasY,ZEmphasizeOn$,ZEmphasizeOff$)
      IF AlreadyColorized THEN _
         EXIT SUB
      WasX = INSTR(Strng$,"<")
      IF WasX < 1 THEN _
         GOTO 59945
59943 WasY = INSTR(WasX,Strng$,">")
      IF WasY < 1 THEN _
         GOTO 59945
      CALL Bracket (Strng$,WasX,WasY,ZFG4$,ZEmphasizeOff$)
      WasY = INSTR(Strng$," ")
      IF WasY > 1 AND WasY < WasX THEN _
         Strng$ = ZFG1$ + Strng$ : _
         WasZ = INSTR(WasY+1,Strng$," ") : _
         IF WasZ > 1 AND WasZ < WasX+LEN(ZFG1$) THEN _
            Strng$ = LEFT$(Strng$,WasZ) + ZFG2Def$ + MID$(Strng$,WasZ+1)
      EXIT SUB
59945 WasX = 1
      DidInsert = ZFalse
      WasL = LEN(ZFG4$)
59950 WasY = INSTR (WasX,Strng$,")")  ' x: where command begins, y: terminating pos
      WasZ = INSTR (WasX,Strng$,",")
      IF WasY = 0 OR (WasZ > 0 AND WasZ < WasY) THEN _
         WasY = WasZ
      WasK = LEN(Strng$)
      IF WasX > WasK THEN _
         EXIT SUB
      IF WasY < 1 THEN _
         IF NOT DidInsert THEN _
            EXIT SUB _
         ELSE WasY = WasK+1
      WasZ = WasY - 1
      WHILE WasZ > 0    ' got terminating pos: find beginning
         IF INSTR(ZOptionEnd$,MID$(Strng$,WasZ,1)) > 0 THEN _
            WasX = WasZ + 1 : _
            WasZ = 0
         WasZ = WasZ - 1
      WEND
      IF WasY-WasX < 3 THEN _     ' exclude commands too long
         CmndString$ = MID$(Strng$,WasX,WasY-WasX) : _
         WasX$ = CmndString$ : _
         CALL AllCaps (CmndString$) : _
         IF WasX$ = CmndString$ THEN _  ' exclude lower case
            DidInsert = ZTrue : _
            CALL Bracket (Strng$,WasX,WasY-1,ZFG4$,ZEmphasizeOff$) : _  ' colorize
            WasY = WasY + WasL
      WasX = WasY + 1
      GOTO 59950
      END SUB
59960 ' $SUBTITLE: 'Bracket - Inserts strings around a string'
' $PAGE
'
'  NAME    --  Bracket
'
'  INPUTS  --  PARAMETER                   MEANING
'              Strng$              Insert in this string
'              B4Here              Insert 1st before this pos
'              AfterHere           Insert 2nd after this pos
'              B4String$           String to insert before
'              AfterString$        String to insert after
'
'  OUTPUTS --  Strng$
'
'  PURPOSE -- Primarily for colorization
'
      SUB Bracket (Strng$,B4Here,AfterHere,B4String$,AfterString$) STATIC
      Strng$ = LEFT$(Strng$,B4Here-1) + _
               B4String$ + _
               MID$(Strng$,B4Here,AfterHere-B4Here+1) + _
               AfterString$ + _
               RIGHT$(Strng$,LEN(Strng$) - AfterHere)
      END SUB
59965 ' $SUBTITLE: 'UserColor - lets user set color for normal text'
' $PAGE
'
'  NAME    --  UserColor
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZEmphasizeOff$            Normal text color
'
'  OUTPUTS --  ZEmphasizeOff$            New text color
'              ZBoldText$                Whether bold (0 not, 1 bold)
'              ZUserTextColor            ANSI Color selected
'
'  PURPOSE --  Lets caller select desired color and whether bold.
'
      SUB UserColor STATIC
      IF ZHiLiteOff THEN _
         EXIT SUB
59970 CALL QuickTPut (ZEmphasizeOff$,0)
      ZOutTxt$ = "Make text R)ed,G)reen,Y)ellow,B)lue,P)urple,C)yan,W)hite" + ZPressEnterExpert$
      GOSUB 59973
      IF ZWasQ = 0 THEN _
         ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + _
             ";40;" + MID$(STR$(ZUserTextColor),2) + "m" : _
         EXIT SUB
      CALL AllCaps (ZUserIn$)
      WasX = INSTR("RGYBPCW",ZUserIn$)
      IF WasX = 0 THEN _
         GOTO 59970
      ZUserTextColor = 30 + WasX
      ZOutTxt$ = "Make text BOLD (Y,[N])"
      GOSUB 59973
      ZBoldText$ = CHR$(48 - ZYes)
      ZEmphasizeOff$ = ZEscape$ + "[" + ZBoldText$ + ";40;" + MID$(STR$(ZUserTextColor),2) + "m"
      GOTO 59970
59973 ZSubParm = 1
      ZTurboKey = -ZTurboKeyUser
      CALL TGet
      IF ZSubParm = -1 THEN _
         EXIT SUB
      RETURN
      END SUB
59980 ' $SUBTITLE: 'SetGraphic - Sets user graphic preference'
' $PAGE
'
'  NAME    --  SetGraphic
'
'  INPUTS  --  PARAMETER                   MEANING
'              GraphicsNumber        0=None, 1=Ascii, 2=color
'
'  OUTPUTS --  ZWasGR                Shared var - set to
'                                    graphics.number
'              GraphicsLetter$       What add to file name to
'                                see if got graphics file ver
'
'  PURPOSE --  Sets file graphics preference
'
      SUB SetGraphic (GraphicsNumber,GraphicsLetter$) STATIC
      ZWasGR = GraphicsNumber
      IF ZWasGR = 2 THEN _
         ZDR1$ = ZFG1Def$ : _
         ZDR2$ = ZFG2Def$ : _
         ZDR3$ = ZFG3Def$ : _
         ZDR4$ = ZFG4Def$ _
      ELSE ZDR1$ = "" : _
           ZDR2$ = "" : _
           ZDR3$ = "" : _
           ZDR4$ = ""
      GraphicsLetter$ = MID$(" GC",ZWasGR+1, - (ZWasGR > 0))
      END SUB
60000 ' $SUBTITLE: 'EofComm - Determines whether input in comm port buffer'
' $PAGE
'
'  NAME    --  EofComm
'
'  INPUTS  --  PARAMETER                   MEANING
'               ZFossil              Whether fossil driver used
'               ZComPort            Comm port # in use
'
'  OUTPUTS --  NoChars           -1 (True) if no chars in buffer.
'                                   Anything else means has char.
'
'  PURPOSE -- Query comm port to see if input waiting
'
      SUB EofComm (NoChars) STATIC
      IF ZFossil THEN _
         CALL FosReadAhead(ZComPort,NoChars) _
      ELSE NoChars = EOF(3)
      END SUB
60100 ' $SUBTITLE: 'GlobalSrchRepl - Global search and replace'
' $PAGE
'
'  NAME    --  GlobalSrchRepl
'
'  INPUTS  --  PARAMETER                   MEANING
'              Strng$              String to edit
'              LookFor$           String to look for
'              ReplaceBy$         String to replace by
'
'  OUTPUTS --  Strng$              Edited string
'
'  PURPOSE --  Replaces every occurence of LookFor$ that
'                         is in Strng$ by ReplaceBy$
'
      SUB GlobalSrchRepl (Strng$,LookFor$,ReplaceBy$,OverStrike) STATIC
      IF LookFor$ = "" THEN _
         EXIT SUB
      WasX = 1
      WasL = LEN(ReplaceBy$)
      ZMsgPtr = LEN(LookFor$)
60102 WasY = INSTR(WasX,Strng$,LookFor$)
      IF WasY < 1 THEN _
         EXIT SUB
      IF OverStrike THEN _
         MID$(Strng$,WasY) = ReplaceBy$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
      ELSE Strng$ = LEFT$(Strng$,WasY-1) + _
                    ReplaceBy$ + _
                    RIGHT$(Strng$,LEN(Strng$)-WasY+1-ZMsgPtr)
      WasX = WasY + WasL
      IF WasX > LEN(Strng$) THEN _
         EXIT SUB
      GOTO 60102
      END SUB
60130 ' $SUBTITLE: 'MetaGSR -- Meta Global search and replace'
' $PAGE
'
'  NAME    --  MetaGSR
'
'  INPUTS  --  PARAMETER               MEANING
'              Strng$              String to edit
'
'  OUTPUTS --  Strng$              Edited string
'
'  PURPOSE --  Global search and replace for meta variables
'
      SUB MetaGSR (Strng$,OverStrike) STATIC
      WasY = 1
60131 IF WasY > LEN(Strng$) THEN _
         EXIT SUB
      WasX = INSTR(WasY,Strng$,"[")
      IF WasX = 0 THEN _
         EXIT SUB
      WasY = INSTR(WasX,Strng$,"]")
      IF WasY = 0 THEN _
         EXIT SUB
      ZMsgPtr = WasY-WasX+1
      Temp = WasY-WasX-1
      CALL CheckInt(MID$(Strng$,WasX+1,Temp))
      IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR (ZTestedIntValue > ZMaxWorkVar) THEN _
         GOTO 60135
      IF ((ZTestedIntValue < 10) AND (Temp = 1)) OR ((ZTestedIntValue > 9) AND (Temp = 2)) THEN _
         GOTO 60132
      WasY = WasX + 1
      GOTO 60131
60132 WorkHold$ = ZGSRAra$(ZTestedIntValue)
      IF WasY = LEN(Strng$) THEN _
         GOTO 60151
      IF MID$(Strng$,WasY+1,1) <> "(" THEN _
         GOTO 60151
      WasI = INSTR(WasY+1,Strng$,")")
      IF WasI = 0 THEN _
         GOTO 60151
      WasJ = INSTR(WasY+1,Strng$,":")
      IF WasJ > WasI THEN _
         GOTO 60151
      CALL CheckInt (MID$(Strng$,WasY+2))
      IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
         (ZTestedIntValue > LEN(WorkHold$)) THEN _
            GOTO 60151
      WasY = WasI
      ZMsgPtr = WasI-WasX+1
      StartSub = ZTestedIntValue
      CALL CheckInt (MID$(Strng$,WasJ+1))
      IF ZErrCode > 0 OR ZTestedIntValue < 1 OR _
         (ZTestedIntValue > LEN(WorkHold$)) THEN _
            GOTO 60151
      LenSub = ZTestedIntValue
      WorkHold$ = MID$(WorkHold$,StartSub,LenSub)
      GOTO 60151
60135 MetaVal$ = MID$(Strng$,WasX+1,WasY-WasX-1)
      WasI = INSTR("      BAUD  PORT  PORT# PARITYPROTO NODE  FILE  ",MetaVal$)
      IF WasI = 0 OR LEN(MetaVal$) < 4 THEN _
         WasY = WasX + 1 : _
         GOTO 60131
      WasJ = (WasI-1)\6 + 1
      WasK = (WasI+4)\6 + 1
      IF WasK > WasJ THEN _
         EXIT SUB
      ON WasJ GOTO 60155, _
                60137, _
                60139, _
                60141, _
                60143, _
                60145, _
                60147, _
                60149, _
                60151
60137 WorkHold$ = ZTalkToModemAt$
      GOTO 60151
60139 WorkHold$ = ZComPort$
      GOTO 60151
60141 WorkHold$ = MID$(ZComPort$,4)
      GOTO 60151
60143 WorkHold$ = MID$(ZBaudParity$,INSTR(ZBaudParity$,",")+1,1)
      GOTO 60151
60145 WorkHold$ = ZWasFT$
      GOTO 60151
60147 WorkHold$ = ZNodeID$
      GOTO 60151
60149 IF ZBatchTransfer THEN _
         WorkHold$ = "@" + ZNodeWorkFile$ _
      ELSE WorkHold$ = ZFileName$
      GOTO 60151
60151 WasL = LEN(WorkHold$)
      IF OverStrike THEN _
         MID$(Strng$,WasX) = WorkHold$ + SPACE$((WasL-ZMsgPtr)*(WasL < ZMsgPtr)) _
      ELSE Strng$ = LEFT$(Strng$,WasX-1) + WorkHold$ + RIGHT$(Strng$,LEN(Strng$)-WasY)
      WasY = 1 ' WasY = WasX + WasL
      GOTO 60131
60155 WasY = WasY + 1
      GOTO 60131
      END SUB
60180 ' $SUBTITLE: 'TimeLock - Test TIME LOCK for premium features'
' $PAGE
'
'  NAME    --  TimeLock  (written by Doug Azzarito)
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZTimeLockSet               SECONDS/SESSION TO LOCK
'
'  OUTPUTS --  ZSubParm     -1 if feature is LOCKED
'
'  PURPOSE -- Check elapsed time for lock duration
'
      SUB TimeLock STATIC
      CALL TimeRemain(MinsRemaining)
      IF ZSecsUsedSession! >= ZTimeLockSet THEN _
         ZOK = ZTrue : _
         EXIT SUB
      ZOutTxt$ = ZFirstName$
      CALL NameCaps(ZOutTxt$)
      CALL QuickTPut1 ("Sorry, " + ZOutTxt$ + ", function locked" + _
                   STR$(INT((ZTimeLockSet-ZSecsUsedSession!)/60)) + _' DA11102
                   " more minutes" + _
                   STR$(INT(ZTimeLockSet-ZSecsUsedSession!) MOD 60) + " seconds")
      CALL BufFile(ZHelpPath$+"TIMELOCK"+ZHelpExtension$,WasX)
      ZOK = ZFalse
      ZLastIndex = 0                                                 ' KG061501
      END SUB
60200 ' $SUBTITLE: 'MarkTime - Give feedback for lengthy processes'
' $PAGE
'
'  NAME    --  MarkTime
'
'  INPUTS  --  PARAMETER                   MEANING
'              DotNumber          How many dots printed
'
'  OUTPUTS --  DotNumber
'
'  PURPOSE --  Marks time by putting colorized dots out
'              to 4, then erasing
'
      SUB MarkTime (DotNumber) STATIC
      TimeNow! = TIMER
      IF TimeNow! - PrevTI! < 1.0 THEN _
         EXIT SUB
      PrevTI! = TimeNow!
      IF RemoveDot AND DotNumber > 0 THEN _
         CALL QuickTPut (ZBackSpace$,0) : _
         DotNumber = DotNumber - 1 : _
         EXIT SUB
      DotNumber = DotNumber + 1
      ON DotNumber GOTO 60201,60202,60203,60204
60201 WasX$ = ZFG1$
      RemoveDot = ZFalse
      GOTO 60205
60202 WasX$ = ZFG2$
      GOTO 60205
60203 WasX$ = ZFG3$
      GOTO 60205
60204 WasX$ = ZFG4$
      RemoveDot = ZTrue
60205 CALL QuickTPut (WasX$ + "." + ZEmphasizeOff$,0)
      END SUB
60300 ' $SUBTITLE: 'AutoPage - NOTIFIES ZSysop WHEN SPECIFIC USER CALLS'
' $PAGE
'
'  NAME    --  AutoPage   'Contributed  by Gregg and Bob Snyder
'                        'and RoseMarie Siddiqui
'
'  INPUTS  --  ZAutoPageDef$  List of conditions that trigger
'                                       notification and how
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- Search ZAutoPageDef$ for match on whether
'             on name, security level, whether new user.
'             Also controls whether caller notified and
'             number of times sysop has bell rung.
'             And what tune to play (if any).
'
      SUB AutoPage STATIC
      CALL FindIt (ZAutoPageDef$)
      IF NOT ZOK THEN _
         EXIT SUB
      ZErrCode = 0
      ZOK = ZFalse
      WHILE NOT EOF(2) AND ZOK = ZFalse AND ZErrCode = 0
         CALL ReadParms (ZWorkAra$(),4,1)
         IF ZErrCode = 0 THEN _
            ZOK = (ZWorkAra$(1) = ZActiveUserName$) : _
            IF NOT ZOK THEN _
               IF ZNewUser AND ZWorkAra$(1) = "NEWUSER" THEN _
                  ZOK = ZTrue _
               ELSE IF LEFT$(ZWorkAra$(1),1) = "/" AND LEN(ZWorkAra$(1)) > 2 THEN _
                       ZWasB = INSTR (2,ZWorkAra$(1),"/") : _
                       IF ZWasB > 0 AND LEN(ZWorkAra$(1)) > ZWasB THEN _
                          IF ZUserSecLevel <= VAL(MID$(ZWorkAra$(1),ZWasB+1)) AND _
                             ZUserSecLevel >= VAL(MID$(ZWorkAra$(1),2)) THEN _
                                ZOK = ZTrue
      WEND
      CLOSE 2
      IF ZErrCode > 0 OR NOT ZOK THEN _
         ZErrCode = 0 : _
         EXIT SUB
      ZPageStatus$ = "AP!"                                           ' DA080902
      IF LEFT$(ZWorkAra$(2),1) = "N" THEN _
         ZOutTxt$ = "Telling sysop you're on..." : _
         CALL RingCaller
      ZWasB = (ZWorkAra$(4) = "")
      ZWorkAra$(5) = ""
     TempSnoop = ZSnoop                                              ' DA101801
     ZSnoop = ZTrue                                                  ' DA101801
     CALL Line25                                                     ' DA102401
      FOR WasI = 1 TO VAL(ZWorkAra$(3))
         IF ZWasB THEN _
            CALL LPrnt (ZBellRinger$,0) : _
         ELSE ZWorkAra$(5) = ZWorkAra$(5) + "O4 X" + VARPTR$(ZWorkAra$(4))
      NEXT
      IF NOT ZWasB THEN _
         CALL RBBSPlay (ZWorkAra$(5))
      ZSnoop = TempSnoop                                             ' DA101801
      END SUB
62520 ' $SUBTITLE: 'PutMsgAttr - subroutine to save msg. attributes'
' $PAGE
'
'  NAME    --  PutMsgAttr
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZWasQ
'              ZUserIn$
'              ZLinesInMsg
'              ZWasS
'              ZNonStop
'              ZMsgDimIndex
'
'  OUTPUTS --  ZWasSQ
'              ZWasLG$(10)
'              ZLinesInMsgSave
'              ZWasSL
'              ZNonStopSave
'              ZMsgDimIndexSave
'
'  PURPOSE --  WHEN REPLYING TO A MESSAGE THIS ROUTINE SAVES
'              THE ATTRIBUTES OF THE ORGINAL MESSAGE
'
      SUB PutMsgAttr STATIC
      ZWasSQ = ZWasQ
      ZWasLG$(10) = ZUserIn$
      ZLinesInMsgSave = ZLinesInMsg
      ZWasSL = ZWasS
      ZNonStopSave = ZNonStop
      ZMsgDimIndexSave = ZMsgDimIndex
      END SUB
62530 ' $SUBTITLE: 'GetMsgAttr - subroutine to get msg. attributes'
' $PAGE
'
'  NAME    --  GetMsgAttr
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZWasSQ
'              ZWasLG$(10)
'              ZLinesInMsgSave
'              ZWasSL
'              ZNonStopSave
'              ZMsgDimIndexSave
'
'  OUTPUTS --  ZWasQ
'              ZUserIn$
'              LINES.IN.MESSAGESAVE
'              ZWasS
'              ZNonStop
'              ZMsgDimIndex
'              ZKillMessage
'
'  PURPOSE --  After replying to a message this routine restores
'              the attributes of the orginal message
'
      SUB GetMsgAttr STATIC
      ZWasQ = ZWasSQ
      ZUserIn$ = ZWasLG$(10)
      ZLinesInMsg = ZLinesInMsgSave
      ZWasS = ZWasSL
      ZNonStop = ZNonStopSave
      ZMsgDimIndex = ZMsgDimIndexSave
      ZKillMessage = ZFalse
      END SUB
62540 ' $SUBTITLE: 'RptTime -- Reports time on system'
' $PAGE
'
'  NAME    --  RptTime
'
'  INPUTS  --  PARAMETER                   MEANING
'
'  OUTPUTS --
'
'  PURPOSE --  Tells user time used on system
'
      SUB RptTime STATIC
      CALL SkipLine (1)
      CALL GetTime
      CALL AMorPM
      Mins = (ZSessionHour * 60) + ZSessionMin
      CALL Carrier
      IF ZSubParm = -1 THEN _
         EXIT SUB
      CALL QuickTPut1 ("Now: " + DATE$ + " at " + TIME$)
      CALL QuickTPut1 ("On for" + STR$(Mins) + " mins," + _
                        STR$(ZSessionSec) + " secs")
      CALL Talk (7,ZOutTxt$)
      END SUB
62600 ' $SUBTITLE: 'Protocol - Determine protocols available'
' $PAGE
'
'  NAME    -- Protocol
'
'  INPUTS  --     PARAMETER                    MEANING
'                 ZProtoDef$                File of installed protocols
'
'  OUTPUTS -- ZTransferOption$         Prompt for protocol choice
'             ZDefaultXfer$            Letters of protocols
'             ZInternalEquiv$          Internal protocol to use
'
'  PURPOSE -- TO determine what protocols are available to user
'
      SUB Protocol STATIC
      CALL FindIt (ZProtoDef$)
      IF NOT ZOK THEN _
         ZTransferOption$ = "A)scii,X)modem,C)rcXmodem,Y)modem" : _
         ZInternalEquiv$ = "AXCY" : _
         ZDefaultXfer$ = "AXCY" : _
         GOTO 62604
      ZDefaultXfer$ = ""
      ZInternalEquiv$ = ""
      ZTransferOption$ = ""
      WasL = 0
62602 IF EOF(2) THEN _
         GOTO 62604
      CALL ReadParms (ZWorkAra$(),13,1)
      IF ZErrCode > 0 THEN _
         EXIT SUB
      ZDefaultXfer$ = ZDefaultXfer$ + " "
      ZInternalEquiv$ = ZInternalEquiv$ + " "
      IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
         GOTO 62602
      IF LEFT$(ZWorkAra$(5),1) = "R" THEN _
         IF NOT ZReliableMode THEN _
            GOTO 62602
      IF LEFT$(ZWorkAra$(3),1) = "I" THEN _
         GOTO 62603
      WasX = INSTR(ZWorkAra$(12)+" "," ")
      WasX$ = LEFT$(ZWorkAra$(12),WasX-1)
      CALL FindFile (WasX$,Found)
      IF Found THEN _
         WasX = INSTR(ZWorkAra$(13)+" "," ") : _
         WasX$ = LEFT$(ZWorkAra$(13),WasX-1) : _
         CALL FindFile (WasX$,Found)
      IF NOT Found THEN _
         GOTO 62602
62603 MID$(ZDefaultXfer$,LEN(ZDefaultXfer$),1) = LEFT$(ZWorkAra$(1),1)
      CALL FindLast (ZWorkAra$(1),ZCrLf$,WasX,WasI)
      IF WasX > 0 AND WasX >= LEN(ZWorkAra$(1)) - 2 THEN _
         ZWorkAra$(1) = LEFT$(ZWorkAra$(1),WasX-1)
      IF (WasL + LEN(ZWorkAra$(1)) < 62) AND WasX = 0 THEN _
         ZTransferOption$ = ZTransferOption$ + "," + ZWorkAra$(1) : _
         WasL = WasL + LEN(ZWorkAra$(1)) + 1 _
      ELSE WasL = LEN(ZWorkAra$(1)) : _
           ZTransferOption$ = ZTransferOption$ + _
                              ZCrLf$ + _
                              ZWorkAra$(1)
      IF LEFT$(ZWorkAra$(3),1) = "I" AND RIGHT$(ZWorkAra$(3),1) <> "I" THEN _
         MID$(ZInternalEquiv$,LEN(ZInternalEquiv$),1) = RIGHT$(ZWorkAra$(3),1)
      GOTO 62602
62604 IF INSTR(ZInternalEquiv$,"N") > 0 THEN _
         GOTO 62605
      IF WasX = 0 THEN _
         ZTransferOption$ = ZTransferOption$ + ",N)one" _
      ELSE ZTransferOption$ = ZTransferOption$ + ZCrLf$ + "N)one"
      ZDefaultXfer$ = ZDefaultXfer$ + "N"
      ZInternalEquiv$ = ZInternalEquiv$ + "N"
62605 IF LEFT$(ZTransferOption$,1) = "," THEN _
         ZTransferOption$ = MID$(ZTransferOption$,2)
      IF INSTR(ZDefaultXfer$,ZUserXferDefault$) = 0 THEN _
         CALL QuickTPut1 ("Protocol "+ZUserXferDefault$+" unavailable.  Default reset to None") : _
         ZUserXferDefault$ = MID$(ZDefaultXfer$,INSTR(ZInternalEquiv$,"N"),1)
      END SUB
62620 ' $SUBTITLE: 'Transfer - Subroutine for external protocols'
' $PAGE
'
'  NAME    -- Transfer
'
'  INPUTS  --     PARAMETER                    MEANING
'              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
'                                        = 2 UPLOAD FILE TO RBBS-PC
'              ZFileName$                NAME OF FILE FOR Transfer
'              ZComPort$                 NAME OF COMMUNICATIONS PORT
'                                        TO BE USED BY KERMIT (COM1
'                                        OR COM2)
'              ZBPS                      = -1 FOR   300 BAUD
'                                        = -2 FOR   450 BAUD
'                                        = -3 FOR  1200 BAUD
'                                        = -4 FOR  2400 BAUD
'                                        = -5 FOR  4800 BAUD
'                                        = -6 FOR  9600 BAUD
'                                        = -7 FOR 19200 BAUD
'
'  OUTPUTS  -- NONE
'
'  PURPOSE -- To transfer files using external protocols
'
      SUB Transfer STATIC
      IF ZPrivateDoor THEN _
         CALL PrivDoorRtn : _
         EXIT SUB
      IF ZTransferFunction = 1 THEN _
         ZUserIn$ = ZDownTemplate$ : _
         ZWasZ$ = "send " _
      ELSE IF ZTransferFunction = 2 THEN _
              ZUserIn$ = ZUpTemplate$ : _
              ZWasZ$ = "receive "
      CALL MetaGSR (ZUserIn$,ZFalse)
      CALL QuickTPut1 ("Protocol     : "+ZProtoPrompt$)
      CALL QuickTPut ("Ready to " + ZWasZ$ + " ",0)
      IF ZBatchTransfer THEN _
         CALL QuickTPut1 ("(BATCH)") : _
         CALL OpenWork (2,ZNodeWorkFile$) : _
         WHILE NOT EOF(2) : _
           CALL ReadAny : _
           CALL BreakFileName (ZOutTxt$,ZWasZ$,ZWasY$,WasX$,ZTrue) : _
           CALL QuickTPut1 ("   "+ZWasY$+WasX$) : _
         WEND _
      ELSE CALL QuickTPut1 (ZFileNameHold$)
      IF ZAutoLogoffReq THEN _
         CALL QuickTPut1 ("Automatic logoff, if download OK")        ' KG071902
      CALL PrivDoorRtn
      END SUB
62624 ' $SUBTITLE: 'PrivDoorRtn - subroutine to exit as a private door.'
' $PAGE
'
'  NAME    -- PrivDoorRtn
'
'  INPUTS  --     PARAMETER                    MEANING
'              ZTransferFunction         = 1 DOWNLOAD FILE TO USER
'                                        = 2 UPLOAD FILE TO RBBS-PC
'                                        = 3 USER REGISTRATION PGM
'              ZUserIn$                      NAME OF FILE TO EXIT TO
'              ZComPort$                 NAME OF COMMUNICATIONS PORT
'                                        TO BE USED BY KERMIT (COM1
'                                        OR COM2)
'              ZBPS                      = -1 FOR   300 BAUD
'                                        = -2 FOR   450 BAUD
'                                        = -3 FOR  1200 BAUD
'                                        = -4 FOR  2400 BAUD
'                                        = -5 FOR  4800 BAUD
'                                        = -6 FOR  9600 BAUD
'                                        = -7 FOR 19200 BAUD
'
'  OUTPUTS -- NONE
'
'  PURPOSE -- To transfer control to another program
'
      SUB PrivDoorRtn STATIC
      IF ZPrivateDoor THEN _
         GOTO 62630
      IF ZFakeXRpt THEN _
         CALL FakeXRpt (ZWasFT$)
      IF ZAdvanceProtoWrite THEN _
         CALL OpenOutW ("XFER-"+ZNodeID$+".DEF") : _
         IF ZErrCode < 1 THEN _
            CALL PrintWorkA (ZFileName$+",,"+ZWasFT$) : _
            CLOSE 2
      IF ZProtoMethod$ = "S" THEN _
         GOTO 62629
62628 WasX$ = LEFT$(ZUserIn$,INSTR(ZUserIn$+" "," ")-1)
      IF WasX$ = "" THEN _
         EXIT SUB
      CALL FindIt (WasX$)
      IF NOT ZOK THEN _
         ZOutTxt$ = "Missing door program" : _
         CALL UpdtCalr (ZOutTxt$ + " " + WasX$,1) : _
         ZSnoop = ZTrue : _
         CALL LPrnt (ZOutTxt$,1) : _
         EXIT SUB
      ZOutTxt$(1) = "CLS"
      GOSUB 62633
      ZOutTxt$(2) = "ECHO" + ZOutTxt$
      ZOutTxt$(3) = ZDiskForDos$ + _
              "COMMAND /C " + _
              ZUserIn$
      ZOutTxt$(4) = ZRBBSBat$
      ZPrivateDoor = ZTrue
      CALL QuickTPut1 ("Exiting to External Pgm for Transfer")
      LOCATE 25,1
      CALL LPrnt(ZLineFeed$,0)
      CALL RBBSExit (ZOutTxt$(),4)
62629 GOSUB 62633
      CLS
      CALL LPrnt (ZOutTxt$,1)
      CALL ShellExit (ZUserIn$)
62630 IF ZPrivateDoor THEN _
         CALL RestoreCom : _
         CALL DelayTime (7 + ZBPS) : _
         CALL SetBaud : _
         CALL QuickTPut1 ("Reloading RBBS-PC.  Please be patient.")
62631 CALL SkipLine (2)
      LOCATE 24,1
62632 EXIT SUB
62633 ZOutTxt$ = STR$(ZUserSecLevel) + _
                 " " + _
                 ZActiveUserName$ + _
                 " " + _
                 ZWasCI$
      RETURN
      END SUB
62650 ' $SUBTITLE: 'FakeXRpt - subroutine to create fake xfer report'
' $PAGE
'
'  NAME    --  FakeXRpt
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZFileNameHold$      FILE TO BE TRANSFERRED
'              ProtoUsed$          Protocol USED
'
'  OUTPUTS --  WRITES OUT Transfer FILE REPORT
'
'  PURPOSE --  External protocol drivers that do not write
'              out a standard transfer report must have one
'              provided in order for "dooring" to external
'              protocols to work properly, since this file
'              is read upon returning from an external protocol.
'
      SUB FakeXRpt (ProtoUsed$) STATIC
      CLOSE 2
      OPEN "O",2,"XFER-" + _
                 ZNodeFileID$ + _
                 ".DEF"
      PRINT #2,ZFileName$
      PRINT #2,
      PRINT #2,ProtoUsed$
      PRINT #2,"S"
      CLOSE 2
      END SUB
62660 ' $SUBTITLE: 'SetExpert - subroutine to adjust for expert change'
' $PAGE
'
'  NAME    --  SetExpert
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZExpertUser          WHETHER IS AN EXPERT
'
'  OUTPUTS --  ZMorePrompt$         Pause prompt
'              ZPressEnter$         Prompt to press enter
'
'  PURPOSE --  Make more helpful prompt for novices and shorter
'              one for experts
'
      SUB SetExpert STATIC
      IF ZExpertUser THEN _
         ZMorePrompt$ = "More <[Y],N,C,A" : _
         ZPressEnter$ = ZPressEnterExpert$ : _
         EXIT SUB
      ZMorePrompt$ = "More [Y]es,N)o,C)ont,A)bort"
      ZPressEnter$ = ZPressEnterNovice$
      END SUB
62668 ' $SUBTITLE: 'NewPassword - subroutine to get new password'
' $PAGE
'
'  NAME    --  NewPassword
'
'  INPUTS  --  PARAMETER                   MEANING
'              Prompt$               Prompt to display
'              DisallowSpaces        Whether answer can have all spaces
'
'  OUTPUTS --  ZWasZ$                   Password
'
'  PURPOSE --  To get a new password.
'
      SUB NewPassword (Prompt$,DisallowSpaces) STATIC
62670 ZOutTxt$ = Prompt$
      ZHidden = ZTrue
      CALL PopCmdStack
      ZHidden = ZFalse
      IF ZSubParm < 0 OR ZWasQ = 0 THEN _
         EXIT SUB
      IF LEN(ZUserIn$) > 15 THEN _
         CALL QuickTPut1 ("15 chars max") : _
         GOTO 62670
      IF INSTR(ZUserIn$,";") > 0 THEN _
         CALL QuickTPut1 ("Cannot use ';'") : _
         GOTO 62670
      IF DisallowSpaces THEN _
         IF ZUserIn$ = SPACE$(LEN(ZUserIn$)) THEN _
            CALL QuickTPut1 ("Not all blanks") : _
            GOTO 62670
      CALL AllCaps (ZUserIn$)
      ZWasZ$ = ZUserIn$
      END SUB
63000 ' $SUBTITLE: 'TimedOut - exits based on time of day'
' $PAGE
'
'  NAME    --  TimedOut
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZRCTTYBat$
'              ZNodeRecIndex
'              ZMsgRec$
'              ZModemInitBaud$
'              ZModemGoOffHookCmnd$
'
'  OUTPUTS --  NONE
'
'  PURPOSE --  When RBBS-PC is to exit to DOS at a specific time of
'              day, this routine writes out to the file specified
'              in "RCTTY.BAT" the one-line entry:
'                          RBBSxTM.BAT
'               WHERE "x" is the node id.
'
      SUB TimedOut STATIC
      FIELD #1,128 AS ZMsgRec$
      ZSubParm = 3
      CALL FileLock
      GET 1,ZNodeRecIndex
      WasX$ = DATE$
      CALL PackDate (WasX$,ZWasY$)
      MID$(ZMsgRec$,77,2) = ZWasY$
      'MID$(ZMsgRec$,86,5) = LEFT$(TIME$,5)
      PUT 1,ZNodeRecIndex
      ZSubParm = 2
      CALL FileLock
      CLOSE 2
      ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "TM.DEF"
      OPEN "O",2,ZFileName$
      PRINT #2,MID$(ZFileName$,3,7)
      CLOSE 2
      IF ZLocalUserMode THEN _
         EXIT SUB
      IF ZSubParm <> 7 THEN _
         ZSubParm = 4 : _
         CALL FileLock : _
         CALL OpenCom(ZModemInitBaud$,",N,8,1")
      CALL TakeOffHook
      END SUB
64003 ' $SUBTITLE: 'AskUsers - subroutine to get registration information'
' $PAGE
'
'  NAME    --  AskUsers  (WRITTEN BY JON MARTIN)
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZFileName$           NAME OF THE FILE CONTAINING THE
'                                   SCRIPT TO BE USED WHEN ASKING
'                                   THE USER QUESTIONS.
'              ZActiveUserName$     NAME OF THE CURRENT USER
'              ZUserSecLevel        USER'S SECURITY
'              ZUpperCase           SET IF USER NEEDS UPPERCASE
'
'  OUTPUTS --  WRITE THE USER'S RESPONSES TO THE QUESTIONS TO THE
'              FILE NAME SPECIFIED AS THE First PARAMETER IN THE
'              First RECORD OF THE FILE CONTAINING THE SCRIPT TO
'              BE USED.
'              ZUserSecLevel  CAN BE RAISED OR LOWERED
'
'  PURPOSE --  Provides a sophisticated, script driven mechanism by
'              which a sysop can control the interaction with the
'              user.  Special function questionnaires include the
'              registration questionnaire and the epilog.
'
      SUB AskUsers STATIC
      ZQuestAborted = ZFalse
      ZQuestChainStarted = ZFalse
      REDIM ZOutTxt$(256)
      REDIM ZWorkAra$(ZMaxWorkVar),ZGSRAra$(ZMaxWorkVar)
      PrevAppend$ = ""
'
'
' *  LOAD SCRIPT CONTAINING THE QUESTIONS INTO THE ZOutTxt$ DIMENSION  *
'
'
64005 ZChatAvail = ZFalse
      QestChain = ZFalse
      LastQues = 0
      CALL Graphic (ZUserGraphicDefault$,ZFileName$)
      IF NOT ZOK THEN _
         EXIT SUB
      CALL ReadParms (ZOutTxt$(),2,1)
      IF ZErrCode > 0 THEN _
         EXIT SUB
      PrevAppend$ = AppendFileName$
      AppendFileName$ = ZOutTxt$(1)
      MaxSecLevel = VAL(ZOutTxt$(2))
      WasX = INSTR(ZOutTxt$(2)," ")
      IF WasX > 0 THEN _
         IF ZUserSecLevel < VAL(MID$(ZOutTxt$(2),WasX)) THEN _
            CALL QuickTPut1 ("Higher security needed for questionnaire") : _
            EXIT SUB
'
'
' *  THE First RECORD OF THE SCRIPT FILE CONTAINS THREE PARAMETERS:
' *   1.  THE NAME OF THE FILE TO APPEND THE ANSWERS TO.
' *   2.  THE MAXIMUM SECURITY LEVEL THE + COMMAND CAN RAISE A USER SECURITY
' *   3.  THE MINIMUM SECURITY TO USE THIS QUESTIONNAIRE
' * e.g. 'C:XXX.DAT,6 5' writes answers to C:XXX.DAT, can raise to 6,
' *      and requires security 5 or more to access
      ScriptIndex = 1
      ZOutTxt$(ScriptIndex) = ZActiveUserName$ + _
                         " " + _
                         DATE$ + _
                         " " + _
                         TIME$
64010 IF EOF(2) OR ScriptIndex > 255 THEN _
         GOTO 64100
      ScriptIndex = ScriptIndex + 1
      LINE INPUT #2,ZOutTxt$(ScriptIndex)
      IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
         CALL AllCaps (ZOutTxt$(ScriptIndex)) : _
         CALL Trim (ZOutTxt$(ScriptIndex))
      IF ZUpperCase THEN _
         CALL AllCaps (ZOutTxt$(ScriptIndex))
      IF LEFT$(ZOutTxt$(ScriptIndex),1) = "?" THEN _
         ScriptIndex = ScriptIndex + 1 : _
         ZOutTxt$(ScriptIndex) = "!"
      GOTO 64010
'
'
' *  PROCESS QUESTIONS IN THE SCRIPT AS FOLLOWS:
' *
' * First COLUMN     MEANING
' *      :        THIS LINE IS A LABEL THAT MAY BE BRANCHED TO
' *      !        THIS MEANS THIS IS AN ANSWER
' *      >        THIS IS A "GOTO" COMMAND TO ONE OF THE LABELS
' *      *        THIS MEANS THE LINE IS A MESSAGE TO BE WRITTEN TO THE USER
' *      ?        THIS MEANS THIS IS A QUESTION FOR THE USER
' *      =        THIS MEANS THAT THIS LINE CONTAINS DECISION CRITERIA
' *      -        THIS MEANS TO LOWER THE USER'S SECURITY LEVEL
' *      +        THIS MEANS TO RAISE THE USER'S SECURITY LEVEL
' *      @        THIS MEANS TO ABORT THE QUESTIONNAIRE DO NOT WRITE OUT
' *      &        THIS MEANS TO CHAIN TO ANOTHER QUESTIONNAIRE
' *      M        Execute specified macro
' *      T        Turbo Key
' *      <        Assign value to work variable
'
64100 ScriptMax = ScriptIndex
      ScriptIndex = 1
64110 CALL Carrier
      IF ZSubParm = -1 THEN _
         GOTO 64510
      ScriptIndex = ScriptIndex + 1
      IF ScriptIndex > ScriptMax THEN _
         GOTO 64400
      ZOutTxt$ = MID$(ZOutTxt$(ScriptIndex),2)
      WasX = ZFalse
      IF LEFT$(ZOutTxt$,3) = "/FL" THEN _
         ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _
         WasX = ZTrue
      CALL MetaGSR (ZOutTxt$,WasX)
      CALL SmartText (ZOutTxt$,ZFalse,WasX)
      WasX$ = ZOutTxt$
      ON INSTR(" :!@MT><*?=-+&",LEFT$(ZOutTxt$(ScriptIndex),1)) GOTO _
         64111, _       ' catch invalid lines
         64110, _       ' : label
         64110, _       ' ! stored answer
         64420, _       ' @ abort
         64120, _       ' M macro execute
         64430, _       ' T turbo key
         64440, _       ' > goto label
         64190, _       ' < assign value
         64450, _       ' * display line
         64113, _       ' ? prompt for answer
         64114, _       ' = conditional branch
         64460, _       ' - decrease security level
         64465, _       ' + increase security level
         64470          ' & chain
64111 ZOutTxt$ = "Invalid line.  Column 1 is <" + LEFT$(ZOutTxt$(ScriptIndex),1)+">.  Must be: * ? = + - > @ & M T <"
      ZSubParm = 5
      CALL TPut
      GOTO 64510
64113 LastQues = ScriptIndex  ' process ?
      GOSUB 64180
      ZSubParm = 1
      CALL TGet
      IF ZSubParm = -1 THEN _
         GOTO 64510 _
      ELSE IF ZWasQ = 0 THEN _
              ZOutTxt$ = WasX$ : _
              GOTO 64113 _
           ELSE ZOutTxt$(ScriptIndex + 1) = "!" + _
                                       ZUserIn$ : _
                ZGSRAra$(ZTestedIntValue) = ZUserIn$
      GOTO 64110
64114 IF LEFT$(ZOutTxt$(ScriptIndex),2) = "=#" THEN _        ' Numeric
         GOSUB 64350 : _
         GOTO 64110
      GOSUB 64300             ' process =
      GOTO 64445
64120 ZWasZ$ = MID$(ZOutTxt$(ScriptIndex),2)   ' Execute macro
      CALL Trim (ZWasZ$)
      CALL Macro (ZWasZ$,Found)
      IF Found THEN _
          CALL FDMACEXE
      GOTO 64110
64180 CALL CheckInt (ZOutTxt$)
      IF (ZErrCode > 0) OR (ZTestedIntValue < 1) OR _
          (ZTestedIntValue > ZMaxWorkVar) OR _
          (INSTR("123456789",LEFT$(ZOutTxt$,1)) = 0) THEN _
             ZTestedIntValue = 0 _
      ELSE ZOutTxt$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-1+(ZTestedIntValue > 9))
      RETURN
64190 GOSUB 64180
      IF ZTestedIntValue > 0 THEN _
         ZGSRAra$(ZTestedIntValue) = MID$(ZOutTxt$,2)
      GOTO 64110
'
'
' *  SEARCH FOR GOTO LABEL
'
'
64200 ScriptIndex = 1
      CALL MetaGSR (BranchLabel$,ZFalse)
      CALL SmartText (BranchLabel$,ZFalse,ZFalse)
      CALL AllCaps (BranchLabel$)
      CALL Trim (BranchLabel$)
64210 ScriptIndex = ScriptIndex + 1
      IF ScriptIndex > ScriptMax THEN _
         ZOutTxt$ = BranchLabel$ + _
              " not found!" : _
         ZSubParm = 5 : _
         CALL TPut : _
         IF ZSubParm = -1 THEN _
            RETURN _
         ELSE IF LastQues > 0 THEN _
                 ScriptIndex = LastQues - 1 : _
                 RETURN _
              ELSE GOTO 64510
      IF LEFT$(ZOutTxt$(ScriptIndex),1) <> ":" THEN _
         GOTO 64210
      IF MID$(ZOutTxt$(ScriptIndex),2) <> BranchLabel$ THEN _
         GOTO 64210
      RETURN
'
'
' *  DETERMINE BRANCH LOGIC
'
'
64300 CurEquals = 1
      ZWasZ$ = RIGHT$(ZOutTxt$(LastQues + 1),1)
      CALL AllCaps (ZWasZ$)
64310 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
      IF NextEquals = 0 THEN _
         BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
         GOTO 64320
      IF ZWasZ$ <> _
         MID$(ZOutTxt$(ScriptIndex),CurEquals + 1,1) THEN  _
         CurEquals = NextEquals : _
         GOTO 64310
      BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
64320 GOSUB 64200
      RETURN
'
'
' *  DETERMINE Numeric BRANCH LOGIC
'
'
64350 CurEquals = 1
64360 NextEquals = INSTR(CurEquals + 1, ZOutTxt$(ScriptIndex),"=")
      IF NextEquals = 0 THEN _
         BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2) : _
         GOTO 64380
      Numeric = ZTrue
      LoopIndex = 2
      WHILE LoopIndex < LEN(ZOutTxt$(ScriptIndex - 1)) +1
         IF INSTR("()1234567890- ",MID$(ZOutTxt$(ScriptIndex - 1),LoopIndex,1)) THEN _
            GOTO 64370
         Numeric = ZFalse
64370    LoopIndex = LoopIndex + 1
      WEND
      IF NOT Numeric THEN _
         CurEquals = NextEquals : _
         GOTO 64360
      BranchLabel$ = MID$(ZOutTxt$(ScriptIndex),CurEquals + 2,NextEquals-(CurEquals + 2))
64380 GOSUB 64200
      RETURN
'
'
' *  WRITE RESPONSES TO DESIGNATED FILE
'
'
64400 ScriptIndex = 0
      ZWasEN$ = AppendFileName$
      CALL LockAppend
      IF ZErrCode <> 0 THEN _
         ZOutTxt$ = "Fatal Error in script!" : _
         ZSubParm = 5 : _
         CALL TPut : _
         GOTO 64500
64410 ScriptIndex = ScriptIndex + 1
      IF ScriptIndex > ScriptMax THEN _
         GOTO 64500
      IF LEFT$(ZOutTxt$(ScriptIndex),1) = ":" THEN _
         QuestionSave$ = MID$(ZOutTxt$(ScriptIndex),2) : _
         GOTO 64410
      IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" AND _
         LEN(ZOutTxt$(ScriptIndex)) < 2 THEN _
         GOTO 64410
      IF LEFT$(ZOutTxt$(ScriptIndex),1) = "!" THEN _
         CALL PrintWorkA (QuestionSave$) : _
         CALL PrintWorkA (MID$(ZOutTxt$(ScriptIndex),2))
      IF ScriptIndex = 1 AND _
         AppendFileName$ <> PrevAppend$ THEN _
         CALL PrintWorkA (ZOutTxt$(ScriptIndex))
      IF ZErrCode <> 0 THEN _
         ZOutTxt$ = "Unrecoverable failure in script!" : _
         ZSubParm = 5 : _
         CALL TPut : _
         GOTO 64500
      GOTO 64410
64420 ZQuestAborted = ZTrue  ' @ abort
      GOTO 64510
64430 ZTurboKey = -ZTurboKeyUser   ' T turbo key
      GOTO 64110
64440 BranchLabel$ = ZOutTxt$            ' = branch
      GOSUB 64200
64445 IF ZSubParm = -1 THEN _
         GOTO 64510 _
      ELSE GOTO 64110
64450 ZSubParm = 5      ' * display
      CALL TPut
      GOTO 64445
64460 WasX = -1        ' - lower security
64462 CALL CheckInt (ZOutTxt$)
      IF ZErrCode = 0 THEN _
         Temp = ZUserSecLevel + _
            WasX * ZTestedIntValue : _
         IF Temp <= MaxSecLevel THEN _
            ZUserSecLevel = Temp : _
            ZUserSecSave = ZUserSecLevel : _
            ZAdjustedSecurity = ZTrue
            IF ZOrigMsgFile$ = ZActiveMessageFile$ THEN _            ' KG102703
               ZOrigSec = ZUserSecLevel                              ' KG102703
      GOTO 64110
64465 WasX = 1               ' + raise security
      GOTO 64462
64470 QestChain = ZTrue  ' & chain questionnaires
      ZFileNameHold$ = ZOutTxt$
      GOTO 64110
64500 CALL UnLockAppend
      CALL Carrier
      IF QestChain THEN _
         ZQuestChainStarted = ZTrue : _
         ZFileName$ = ZFileNameHold$ : _
         GOTO 64005
64510 ZChatAvail = (INSTR("MUF",ZActiveMenu$) > 0)
      ZOK = ZTrue
      ZLastIndex = 0
      END SUB
64600 ' $SUBTITLE: 'ViewArc - subroutine to display .ARC contents'
' $PAGE
'
'  NAME    --  ViewArc  (Written by Jon Martin)
'
'  INPUTS  --  PARAMETER                   MEANING
'              ZFileName$           NAME OF THE ARC FILE TO BE
'                                   VIEWED.
'
'  OUTPUTS --  NONE
'
'  PURPOSE --  Provides a mechanism to provide users with the
'              contents of a libraried file prior to downloading.
'
      SUB ViewArc STATIC
      CLOSE 2
      'IF ZTurboRBBS THEN _
         RetCode = 0
         CALL ArcV (ZArcWork$,ZFileName$,RetCode)
         CALL BufFile (ZArcWork$,WasX)
         EXIT SUB
      'IF ZShareIt THEN _
      '   OPEN ZFileName$ FOR RANDOM SHARED AS #2 LEN=1 _
      'ELSE OPEN "R",2,ZFileName$,1
      'FIELD 2,1 AS CHAR$
      'BYTE.POINTER! = 1
      'ARC.END! = LOF(2)
64605 'IF BYTE.POINTER! > ARC.END! THEN _
      '   GOTO 64620
      'GET 2,BYTE.POINTER!
      'IF CHAR$ <> CHR$(26) THEN _
      '   GOTO 64620
      'BYTE.POINTER! = BYTE.POINTER! + 1
      'GET 2,BYTE.POINTER!
      'IF CHAR$ = CHR$(0) THEN _
      '   GOTO 64620
      'ARCED.NAME$ = ""
      'FOR WasX = 1 TO 12
      '   GET 2,BYTE.POINTER! + WasX
      '   IF CHAR$ < CHR$(40) THEN _
      '      GOTO 64610
      '   ARCED.NAME$ = ARCED.NAME$ + _
      '                 CHAR$
      'NEXT
64610 'ZOutTxt$ = ARCED.NAME$
      'BYTE.POINTER! = BYTE.POINTER! + 14
      'GOSUB 64630
      'TOTAL.BYTES# = WORK.BYTES#
      'BYTE.POINTER! = BYTE.POINTER! + 10
      'GOSUB 64630
      'FINAL.BYTES# = WORK.BYTES#
      'ZOutTxt$ = ZOutTxt$ + _
      '     SPACE$(20 - LEN(ARCED.NAME$) - LEN(STR$(FINAL.BYTES#))) + _
      '     STR$(FINAL.BYTES#) + _
      '     " bytes."
      'CALL QuickTPut1 (ZOutTxt$)
      'BYTE.POINTER! = BYTE.POINTER! + TOTAL.BYTES# + 4
      'GOTO 64605
64620 'CLOSE 2
      'ZSubParm = 0
      'CALL Carrier
      'ZOutTxt$ = ""
      'EXIT SUB
64630 'FACTOR# = 1#
      'WORK.BYTES# = 0
      'FOR WasX = 0 TO 3
      '   GET 2,BYTE.POINTER! + WasX
      '   WORK.BYTES# = WORK.BYTES# + FACTOR# * ASC(CHAR$)
      '   FACTOR# = FACTOR# * 256#
      'NEXT
      'RETURN
      END SUB