home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / rbbs_pc / 173_bas.arc / RBBSSUB5.BAS < prev   
BASIC Source File  |  1990-02-10  |  87KB  |  2,661 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: 
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  BinSearch      63520  Binary searches sorted file for a key value
  18. '  BreakFileName  63300  Break file name into component parts
  19. '  BufAsUnit      63500  Buffer out a string with CR's
  20. '  SetPrompt      63470  Set prompts based on the user's security
  21. '  DoorReturn     63100  Process door requests
  22. '  FdMacExe       63462  Executes a found macro
  23. '  FileSystem     20117  File System for RBBS-PC
  24. '  FindIt         63490  Check whether file exists and if so open as #2
  25. '  FormRead       63420  Read from file into a form
  26. '  LockAppend     63400  Prepare for a file append
  27. '  MacroExe       63460  Execute internal macro rather than user
  28. '  MsgNameMatch   63540  Match name to one in msg header
  29. '  NoPath         63480  Detects whether string has a path in it
  30. '  RestoreCom     63310  Restore comm port after external program
  31. '  ReadMacro      63330  Read and process macro
  32. '  ShellExit      63320  Exit RBBS via shell
  33. '  TakeOffHook    63530  Take modem off hook
  34. '  UnLockAppend   63410  Clean up after file append
  35. '  VerifyAns      63510  Verify that string passes edits
  36. '  WildCard       63200  Match string to a pattern
  37. '
  38. '  $INCLUDE: 'RBBS-VAR.BAS'
  39. '
  40. 20117 ' $SUBTITLE: 'FileSystem -- subroutine for RBBS-PC's file system'
  41. ' $PAGE
  42. '
  43. ' NAME    -- FileSystem
  44. '
  45. ' INPUTS  --       PARAMETER                 MEANING
  46. '             ZFileSysParm = 1  LIST THE SYSOP'S COMMENTS FILE
  47. '                                 2  L)IST DIRECTORY COMMAND
  48. '                                 3  D)OWNLOAD COMMAND
  49. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  50. '                                 5  U)PLOAD COMMAND
  51. '                                 6  S)CAN DIRECTORY COMMAND
  52. '                                 7  P)ERSONAL FILES COMMAND
  53. '                                 8  N)EW FILES COMMAND
  54. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  55. '
  56. ' OUTPUTS -- ZFileSysParm = 1  COMMAND PROCESSED SUCCESSFULLY
  57. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  58. '                                3  PROCESS NEXT COMMAND (1200)
  59. '                                4  DENY USER ACCESS (1380)
  60. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  61. '                                6  USER'S TIME EXCEEDED (10553)
  62. '                                7  Carrier DROPPED (10595)
  63. '
  64. ' PURPOSE -- To handle the RBBS-PC file system commands
  65. '
  66.       SUB FileSystem STATIC
  67.       ZFF = ZFileSysParm
  68.       ZFileSysParm = 1
  69.       ON ZFF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  70.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  71.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  72.                   20263, _  ' RETURN FROM EXTERNAL Protocol'S
  73.                   20400, _  ' U)PLOAD COMMAND HANDLER
  74.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  75.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  76.                   21860, _  ' N)EW FILES COMMAND HANDLER
  77.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  78.       GOTO 21920
  79. 20119 ZErrCode = 0
  80.       GOTO 20122
  81. '
  82. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  83. '
  84. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1ZWasA
  85. 20120 ZOutTxt$ = "Scanning Directory " + _
  86.            ZFileNameHold$
  87.       IF WasRS$ <> "" THEN _
  88.          ZOutTxt$ = ZOutTxt$ + " for " + WasRS$
  89.       GOSUB 21650
  90.       IF ZFileSysParm > 1 THEN _
  91.          RETURN
  92.       WasPG = ZTrue
  93. 20122 CALL OpenWork (2,ZFileName$)
  94.       IF ZErrCode = 53 THEN _
  95.          ZOutTxt$ = "Missing File " + ZFileName$ : _
  96.          CALL UpdtCalr (ZOutTxt$,2) : _
  97.          ZOutTxt$ = ZOutTxt$ + _
  98.               ". Please tell SYSOP" : _
  99.          GOSUB 21650 : _
  100.          RETURN
  101.       ZJumpSupported = ZTrue
  102.       ZJumpLast$ = ""
  103.       LastOK = ZFalse
  104. 20124 CALL Carrier
  105.       IF EOF(2) OR _
  106.          (ZSubParm = -1 AND NOT ZLocalUser) THEN _
  107.          GOTO 20142
  108. 20126 CALL ReadDir (2,1)
  109.       IF ZErrCode <> 0 THEN _
  110.          ZWasEL = 20126 : _
  111.          GOTO 21900
  112.       IF WasCK = 0 THEN _
  113.          GOTO 20140
  114.       IF LEFT$(ZOutTxt$,1) = " " THEN _
  115.          IF LastOK AND NOT ZExtendedOff THEN _
  116.             GOTO 20140 _
  117.          ELSE GOTO 20124
  118.       LastOK = ZFalse
  119. 20128 IF ZJumpSearching THEN _
  120.          GOTO 20129
  121.       IF WasCK < 2 THEN _
  122.          GOTO 20130
  123.       IF WildSearch THEN _
  124.          ZWasA = INSTR(ZOutTxt$," ") : _
  125.          IF ZWasA = 0 THEN _
  126.             GOTO 20124 _
  127.          ELSE ZWasZ$ = LEFT$(ZOutTxt$,ZWasA - 1) : _
  128.               CALL WildFile (WasRS$,ZWasZ$,WasXXX) : _
  129.               WasXXX = NOT WasXXX : _
  130.               GOTO 20136
  131. 20129 ZWasZ$ = ZOutTxt$
  132.       CALL AllCaps (ZWasZ$)
  133.       WasXXX = (INSTR(ZWasZ$,WasRS$) = 0)
  134.       GOTO 20136
  135. 20130 ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"/")
  136.       IF ZWasA = 0 THEN _
  137.          ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"-")
  138. 20132 IF ZWasA < 3 THEN _
  139.          GOTO 20124
  140.       IF INSTR("0123456789",MID$(ZOutTxt$,ZWasA - 1,1)) = 0 THEN _
  141.          GOTO 20124
  142.       ZWasA = ZWasA - 2
  143.       WasWK$ = RIGHT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  144.             LEFT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  145.             MID$(MID$(ZOutTxt$,ZWasA,8),4,2)
  146.       IF MID$(WasWK$,3,1) = " " THEN _
  147.          MID$(WasWK$,3,1) = "0"
  148.       IF MID$(WasWK$,5,1) = " " THEN _
  149.          MID$(WasWK$,5,1) = "0"
  150. 20134 WasXXX = (WasWK$ < WasRS$)
  151. 20136 IF WasXXX THEN _
  152.          GOTO 20124
  153.       IF ZJumpSearching THEN _
  154.          WasRS$ = PrevSearch$ : _
  155.          WasCK = PrevCK : _
  156.          ZJumpSearching = ZFalse : _
  157.          GOTO 20140
  158.       IF WasPG THEN _
  159.          WasPG = ZFalse : _
  160.          CALL OpenWork (2,ZFileName$) : _
  161.          ZWasQ = 0 : _
  162.          GOTO 20124
  163. 20138 IF WasPG THEN _
  164.          GOTO 20124
  165. 20140 LastOK = ZTrue
  166.       GOSUB 21650
  167.       IF ZFileSysParm > 1 THEN _
  168.          RETURN
  169.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  170.       IF ZNo THEN _
  171.          ZErrCode = 0 : _
  172.          RETURN
  173.       IF ZJumpSearching THEN _
  174.          IF LEFT$(ZOutTxt$,1) <> " " THEN _
  175.             PrevSearch$ = WasRS$ : _
  176.             PrevCK = WasCK : _
  177.             WasCK = 2 : _
  178.             WasRS$ = ZJumpTo$
  179.       IF NOT ZRet THEN _
  180.          GOTO 20124
  181. 20142 ZWasQ = 0
  182.       ZJumpSupported = ZFalse
  183.       CLOSE 2
  184.       CALL Carrier
  185.       IF ZSubParm = -1 THEN _
  186.          ZFileSysParm = 7
  187.       RETURN
  188. '
  189. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  190. '
  191. 20150 ZListDir = ZTrue
  192.       ListNew = ZFalse
  193.       SearchDate$ = ""
  194.       SearchString$ = ""
  195.       WasRS$ = ""
  196.       ShowDirOfDir = (ZLastIndex <= ZAnsIndex) AND NOT ZExpertUser
  197.       WasCK = 0
  198.       ZSearchingAll = ZFalse
  199. 20155 IF ListNew OR ZAnsIndex > 255 THEN _
  200.          RETURN
  201.       CALL GetDirs (ShowDirOfDir)
  202.       IF ZWasQ = 0 THEN _
  203.          RETURN
  204.       ShowDirOfDir = ZFalse
  205.       CALL ConvertDir (ZAnsIndex)
  206.       WasQX = ZLastIndex
  207. 20157 CALL Carrier
  208.       IF ZSubParm = -1 THEN _
  209.          ZFileSysParm = 7 : _
  210.          RETURN
  211.       GOTO 20161
  212. 20159 IF ZAnsIndex < ZLastIndex THEN _
  213.          GOTO 20155
  214.       ZSearchingAll = ZFalse
  215.       CALL CmdStackPushPop (1)
  216.       ZLastIndex = 0
  217.       IF ZNo OR (ZFileNameHold$ = ZDirPrefix$) THEN _
  218.          GOTO 20155
  219.       CALL QuickTPut (ZEmphasizeOff$,0)
  220.       ZOutTxt$ = "End list.  R)elist, [Q]uit, or download what"
  221.       ZStackC = ZTrue
  222.       GOSUB 21668
  223.       CALL AllCaps (ZUserIn$(1))
  224.       IF ZUserIn$(1) = "R" THEN _
  225.          ZUserIn$(ZAnsIndex) = WasA1$ : _
  226.          GOTO 20161
  227.       IF LEN(ZUserIn$(1)) > 1 AND _
  228.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  229.          ZAnsIndex = 1 : _
  230.          GOSUB 20202
  231.       CALL CmdStackPushPop (2)
  232.       RETURN
  233. 20161 IF INSTR(ZUserIn$(ZAnsIndex),".") THEN _
  234.          GOTO 20172
  235.       ZViolation$ = "List Dir. "
  236.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  237.       ZWasA = INSTR("E+E-E",ZWasZ$)
  238.       IF ZWasA > 0 THEN _
  239.          IF ZWasA = 5 THEN _
  240.             ZExtendedOff = NOT ZExtendedOff : _
  241.             GOTO 20155 _
  242.          ELSE ZExtendedOff = (ZWasA > 2) : _
  243.               GOTO 20155
  244.       CALL AllCaps(ZWasZ$)
  245.       ZFileNameHold$ = ZWasZ$
  246.       WasA1$ = ZWasZ$
  247.       IF ZWasZ$ = ZDirPrefix$ THEN _
  248.          GOTO 20164
  249.       InFMS = ZFalse
  250. 20162 CALL CmdStackPushPop (1)         ' save dir list list processing
  251.       CALL FMS (ZWasZ$,SearchString$,SearchDate$,InFMS, _
  252.                 ZCategoryName$(),ZCategoryCode$(),ZCategoryDesc$(),_
  253.                 DnldFlag,CatFound,ZAnsIndex)
  254.       WHILE DnldFlag > 0 AND ZSubParm > -1
  255.          GOSUB 20202
  256.          IF ZFileSysParm > 1 THEN _
  257.             RETURN
  258.          WasX$ = ZCategoryCode$(CatFound)
  259.          CALL DispUpDir (WasX$,SearchString$,SearchDate$,DnldFlag,ZAnsIndex)
  260.          CALL CheckTimeRemain (MinsRemaining)
  261.          IF ZSubParm = -1 THEN _
  262.             ZFileSysParm = 6 : _
  263.             RETURN
  264.          CALL Carrier
  265.       WEND
  266.       IF ZSubParm = -1 THEN _
  267.          ZFileSysParm = 7 : _
  268.          RETURN
  269.       IF ZAnsIndex > 255 THEN _
  270.          ZLastIndex = 0 : _
  271.          RETURN
  272.       CALL CmdStackPushPop (2)        ' restore dir list list processing
  273.       ZActiveFMSDir$ = ""
  274.       IF InFMS THEN _
  275.          GOTO 20159
  276.       IF ZUserSecLevel < ZMinSecToView THEN _
  277.          IF ZFileNameHold$ = ZUpldDirCheck$ THEN _
  278.             ZFileNameHold$ = "of uploads" : _
  279.             GOTO 20172
  280.       ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  281.       IF ZLimitSearchToFMS THEN _
  282.          GOTO 20166
  283.       IF NOT ZSearchingAll THEN _
  284.          IF ZFileNameHold$ = "ALL" OR ZFileNameHold$ = "A" THEN _
  285.             ZSearchingAll = ZTrue : _
  286.             GOSUB 21890 : _
  287.             GOTO 20157
  288.       CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  289.       ON BadFileNameIndex GOTO 20163,20172,20176
  290. 20163 ZFileName$ = ZFileNameHold$
  291.       CALL BadName (BadFileNameIndex)
  292.       ON BadFileNameIndex GOTO 20164,20176
  293. 20164 IF ZFileName$ = ZUpldDirCheck$ AND _
  294.          ZUserSecLevel >= ZMinSecToView THEN _
  295.             ZFileName$ = ZUpldPath$ _
  296.       ELSE ZFileName$ = ZCurDirPath$
  297.       ZFileName$ = ZFileName$ + _
  298.                    ZFileNameHold$ + _
  299.                    "." + _
  300.                    ZDirExtension$
  301.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  302. 20165 IF ZOK THEN _
  303.          CALL ReadDir (2,1) : _
  304.          IF ZErrCode = 0 THEN _
  305.             IF LEFT$(ZOutTxt$,4) = "\FMS" THEN _
  306.                InFMS = ZTrue : _
  307.                ZActiveFMSDir$ = ZFileName$ : _
  308.                GOTO 20162 _
  309.             ELSE GOTO 20167
  310. 20166 ZFileName$ = ZCurDirPath$ + _
  311.                    ZFileNameHold$ + ".MNU"
  312.       CALL FindIt (ZFileName$)
  313.       IF ZOK THEN _
  314.          CALL BufFile (ZFileName$,ZAnsIndex) : _
  315.          GOTO 20155
  316.       IF ZAltdirExtension$ = "" THEN _
  317.          GOTO 20172
  318.       ZFileName$ = ZCurDirPath$ + _
  319.                    ZFileNameHold$ + _
  320.                    "." + _
  321.                    ZAltdirExtension$
  322.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  323.       IF NOT ZOK THEN _
  324.          GOTO 20172
  325. 20167 ZUserIn$(0) = ZUserIn$(ZAnsIndex)
  326.       GOSUB 20120
  327.       IF ZFileSysParm > 1 THEN _
  328.          RETURN
  329.       GOTO 20170
  330. 20168 CALL BufFile(ZFileName$,ZAnsIndex)
  331.       CALL Carrier
  332.       IF ZSubParm = -1 THEN _
  333.          ZFileSysParm = 7 : _
  334.          RETURN
  335. 20170 IF ZAnsIndex > 255 THEN _
  336.          ZLastIndex = 0 : _
  337.          RETURN
  338.       ZUserIn$(ZAnsIndex) = ZUserIn$(0)
  339.       GOTO 20159
  340. 20172 IF NOT ZSearchingAll THEN _
  341.          ZOutTxt$ = "Directory " + _
  342.               ZFileNameHold$ + _
  343.               " not found!" : _
  344.          GOSUB 21640 : _
  345.          ZNo = ZTrue : _
  346.          IF ZFileSysParm > 1 THEN _
  347.             RETURN
  348.       GOTO 20155
  349. 20176 CALL SecViolation
  350.       IF ZDenyAccess THEN _
  351.          ZFileSysParm = 4 : _
  352.          RETURN
  353.       GOTO 20172
  354. '
  355. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  356. '
  357. 20180 ZOutTxt$ = "Download what file(s)"
  358.       ZStackC = ZTrue
  359.       GOSUB 21668
  360.       IF ZFileSysParm > 1 THEN _
  361.          RETURN
  362.       IF ZWasQ = 0 THEN _
  363.          RETURN
  364. 20202 IF (ZTimeLock AND 2) AND (NOT TimeLockExempt) AND NOT ZHasPrivDoor THEN _
  365.          CALL TimeLock : _
  366.          IF NOT ZOK THEN _
  367.             RETURN
  368.       LastDnld = ZLastIndex
  369.       FirstDnld = ZAnsIndex
  370.       ZCmdTransfer$ = ""
  371.       IF ZAutoDownYes THEN _
  372.          ZCmdTransfer$ = "X"
  373.       ZAutoDownInProgress = ZAutoDownYes
  374.       ZAnsIndex = ZLastIndex
  375.       GOSUB 20470
  376.       LastDnld = LastDnld + (WasX > 0)
  377.       BatchBytes# = 0
  378.       BatchBlocks# = 0
  379.       ZDownFiles = 0
  380.       CALL KillWork (ZNodeWorkFile$)
  381.       ZErrCode = 0
  382.       FOR ZAnsIndex = FirstDnld TO LastDnld
  383.          GOSUB 20470
  384.          GOSUB 20205
  385.          ZCmdTransfer$ = ZWasFT$
  386.          CALL Line25
  387.          IF ZFileSysParm > 1 OR ZInternalProt$ = "N" THEN _
  388.             ZAnsIndex = LastDnld + 1
  389. 20203 NEXT
  390.       ZLastIndex = 0
  391.       IF ZFileSysParm > 1 THEN _
  392.          RETURN
  393.       ZBatchTransfer = ZFalse
  394.       ZCmdTransfer$ = ""
  395.       RETURN
  396. 20205 MarkingTime = (ZAnsIndex = FirstDnld OR NOT ZConcatFIles)
  397.       ZFileName$ = ZUserIn$(ZAnsIndex)
  398.       CALL Remove (ZFileName$,", ")
  399.       ZViolation$ = "Download "
  400.       IF PersonalDnld THEN _
  401.          CALL BreakFileName (ZFileName$,DR$,ZWasY$,WasX$,ZTrue) : _
  402.          ZFileNameHold$ = ZWasY$ + _
  403.                            WasX$ : _
  404.          GOTO 20235
  405.       ZFileNameHold$ = ZFileName$
  406.       CALL BadFile (ZFileName$,BadFileNameIndex)
  407.       ON BadFileNameIndex GOTO 20220,20231,20233
  408. 20220 IF INSTR (ZFileName$,".") = 0 THEN _
  409.          FileNameAlt$ = ZFileName$ : _
  410.          ZFileName$ = ZFileName$ + "." + ZDefaultExtension$ : _
  411.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$ _
  412.       ELSE FileNameAlt$ = ""
  413. 20222 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + _
  414.                       ((ZUserSecLevel < ZMinSecToView) OR _
  415.                        NOT ZCanDnldFromUp),MarkingTime)
  416. 20225 IF ZOK THEN _
  417.          GOTO 20235
  418.       IF ZDotFlag THEN _
  419.          RETURN
  420.       IF FileNameAlt$ <> "" THEN _
  421.          ZFileName$ = FileNameAlt$ : _
  422.          FileNameAlt$ = "" : _
  423.          ZFileNameHold$ = ZFileName$ : _
  424.          GOTO 20222
  425. 20231 ZOutTxt$ = ZFileNameHold$ + _
  426.            " not found!"
  427.       CALL UpdtCalr (ZOutTxt$,2)
  428.       IF ZAutoDownInProgress THEN _
  429.          ZOutTxt$ = ZOutTxt$ + _
  430.               " during AUTODOWNLOAD" : _
  431.          GOSUB 21640 : _
  432.          RETURN
  433.       ZOutTxt$ = ZOutTxt$ + _
  434.            " Correct name"+ZPressEnterExpert$
  435.       ZSuspendAutoLogoff = ZTrue
  436.       GOSUB 21660
  437.       ZSuspendAutoLogoff = ZFalse
  438.       IF ZFileSysParm > 1 THEN _
  439.          RETURN
  440.       IF ZWasQ=0 THEN _
  441.          IF ZBatchTransfer AND ZAnsIndex >= LastDnld THEN _
  442.             GOTO 20262 _
  443.          ELSE ZAutoLogOffReq = ZFalse : _
  444.               RETURN
  445.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  446.       GOTO 20205
  447. 20233 CALL SecViolation
  448.       IF ZDenyAccess THEN _
  449.          ZFileSysParm = 4 : _
  450.          RETURN
  451.       GOTO 20231
  452. 20235 CALL BadName (BadFileNameIndex)
  453.       ON BadFileNameIndex GOTO  20236,20245
  454. 20236 ZLine25$ = "(D) " + _
  455.                  ZWasZ$
  456.       IF ZAutoDownInProgress THEN _
  457.          MID$(ZLine25$,2,1) = "A"
  458. '
  459. ' *  TEST FOR DOWNLOAD SECURITY
  460. '
  461.       CALL OpenWork (2,ZFileSecFile$)
  462.       IF ZErrCode = 53 THEN _
  463.          CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _
  464.          GOTO 20247
  465. 20242 IF EOF(2) THEN _
  466.          GOTO 20247
  467.       CALL ReadParms (ZWorkAra$(),3,1)
  468.       IF ZErrCode <> 0 THEN _
  469.          ZWasEL = 20242 : _
  470.          GOTO 21900
  471. 20243 CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK)
  472.       IF NOT ZOK THEN _
  473.          GOTO 20242
  474. 20244 IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  475.          GOTO 20245
  476.       FilePswd$ = ZWorkAra$(3)
  477.       IF FilePswd$ = "" THEN _
  478.          GOTO 20247
  479.       CALL AllCaps (FilePswd$)
  480.       IF FilePswd$ = ZPswd$ THEN _
  481.          GOTO 20247
  482.       ZOutTxt$ = "Enter PASSWORD to download " + _
  483.            ZFileName$
  484.       GOSUB 21660
  485.       IF ZFileSysParm > 1 THEN _
  486.          RETURN
  487.       IF ZWasQ = 0 THEN _
  488.          RETURN
  489.       CALL AllCaps (ZUserIn$(1))
  490.       IF ZUserIn$(1) = FilePswd$ THEN _
  491.          GOTO 20247
  492. 20245 ZViolation$ = "DownLoad " + _
  493.                    ZFileName$
  494. 20246 CALL SecViolation
  495.       IF ZDenyAccess THEN _
  496.          ZFileSysParm = 4
  497.       RETURN
  498. 20247 ZWasDF = 0
  499.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  500.       IF ZAutoDownInProgress THEN _
  501.          ZOutTxt$ = "Transferring -- " + _
  502.               ZUserIn$(ZAnsIndex) : _
  503.          GOSUB 21640 : _
  504.          IF ZFileSysParm > 1 THEN _
  505.             RETURN
  506.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+Extension$+".") > 2 OR _
  507.          MID$(Extension$,2,1) = "Q" OR _
  508.          (ZRequireNonASCII AND Extension$ = "BAS") THEN _
  509.             ZWasDF = ZTrue
  510. 20248 ZOutTxt$ = ""
  511.       IF ZBatchTransfer THEN _
  512.          IF ZAnsIndex < LastDnld THEN _
  513.             GOTO 20260
  514.       CALL XferType (2,ZTrue)
  515.       IF ZFF THEN _
  516.          GOTO 20260
  517.       CALL XferType (1,ZTrue)
  518.       IF ZSubParm = -1 THEN _
  519.          ZFileSysParm = 7 : _
  520.          RETURN
  521. 20260 ZTransferFunction = 1
  522.       GOSUB 21790
  523.       IF ZFileSysParm > 1 THEN _
  524.          RETURN
  525.       ZBatchTransfer = (ZBatchProto AND (LastDnld > FirstDnld))
  526.       IF ZBatchTransfer AND ZCmdTransfer$ = "" THEN _
  527.          ZCmdTransfer$ = ZWasFT$
  528.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  529.          20340, _              ' ASCII DOWNLOAD
  530.          20290, _              ' Xmodem
  531.          20290, _              ' Xmodem CRC
  532.          20270, _              ' YMODEM
  533.          21700                 ' NONE - CANCEL
  534. '
  535. ' *  EXTERNAL Protocol Downloads/Uploads
  536. '
  537. 20261 IF ZReq8Bit THEN _
  538.          IF NOT ZEightBit THEN _
  539.             GOSUB 20318 : _
  540.             IF ZFileSysParm > 1 THEN _
  541.                RETURN _
  542.             ELSE GOSUB 20992 : _
  543.                  IF ZFileSysParm > 1 THEN _
  544.                     RETURN
  545.       IF ZTransferFunction = 1 THEN _
  546.          GOSUB 20750 : _
  547.          CLOSE 2 : _
  548.          IF ZFileSysParm > 1 OR NOT ZOK THEN _
  549.             RETURN
  550. 20262 IF ZBatchTransfer THEN _
  551.          IF ZAnsIndex < LastDnld THEN _
  552.             RETURN _
  553.          ELSE ZBlocksInFile# = BatchBlocks# : _
  554.               ZBytesInFile# = BatchBytes# : _
  555.               ZNumDnldBytes! = BatchBytes# : _
  556.               IF ZBytesInFile# < 1 THEN _
  557.                  RETURN _
  558.               ELSE GOSUB 20780 : _
  559.                    IF ZFileSysParm > 1 OR NOT ZOK THEN _
  560.                       RETURN
  561.       IF ZAutoDownInProgress THEN _
  562.          CALL SendName : _
  563.          IF ZAbort THEN _
  564.             DnldCompleted = ZFalse : _
  565.             GOSUB 21760 : _
  566.             RETURN
  567.       CALL Transfer
  568. 20263 IF ZPrivateDoor THEN _
  569.          ZCmdTransfer$ = ZWasFT$ : _
  570.          CALL XferType (2,ZTrue) : _
  571.          ZCmdTransfer$ = ""
  572.       CALL OpenWork (2,"XFER-" + ZNodeID$ + ".DEF")
  573.       IF ZErrCode <> 0 THEN _
  574.          GOTO 20267
  575.       CALL ReadParms (ZWorkAra$(), ZFailureParm, 1)
  576.       IF ZErrCode <> 0 THEN _
  577.          GOTO 20267
  578.       CALL KillWork ("XFER-" + ZNodeID$ + ".DEF")
  579. 20264 IF ZPrivateDoor THEN _
  580.          ZFileName$ = ZWorkAra$(1) : _
  581.          CALL BreakFileName (ZFileName$,WasX$,ZFileNameHold$,ZWasY$,ZTrue) : _
  582.          ZFileNameHold$ = ZFileNameHold$ + _
  583.                            ZWasY$
  584.       IF LEFT$(ZWorkAra$(ZFailureParm),1) = "L" THEN _
  585.          MID$(ZWorkAra$(ZFailureParm),1,1) = ZFailureString$
  586. 20265 IF ZTransferFunction = 2 THEN _
  587.          IF INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1 THEN _
  588.             GOTO 20700 _
  589.          ELSE GOTO 20730
  590.       IF ZTransferFunction = 1 THEN _
  591.          DnldCompleted = (INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1)
  592.       GOSUB 21760
  593.       CALL Carrier
  594.       IF ZSubParm = -1 THEN _
  595.          ZFileSysParm = 7
  596.       RETURN
  597. '
  598. ' *  XFER FILE NOT Found
  599. '
  600. 20267 ZWasEL = 20263
  601.       GOTO 21900
  602.  
  603. '
  604. ' *  YMODEM DOWNLOAD DRIVER
  605. '
  606. 20270 GOTO 20292
  607. '
  608. ' *  Xmodem DOWNLOAD DRIVER
  609. '
  610. 20290 '
  611. 20292 GOSUB 20750
  612.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  613.          RETURN
  614.       WasA1$ = "SEND"
  615.       GOSUB 20320
  616.       IF ZFileSysParm > 1 THEN _
  617.          RETURN
  618.       IF ZLocalUser THEN _
  619.          CALL QuickTPut1 ("Protocol not available in local mode") : _
  620.          RETURN
  621.       IF ZAutoDownInProgress THEN _
  622.          GOSUB 20294 : _
  623.          IF ZAbort THEN _
  624.             RETURN
  625.       GOSUB 21300
  626.       IF ZFileSysParm > 1 THEN _
  627.          RETURN
  628.       ZOutTxt$ = ""
  629.       GOTO 20390
  630. 20294 CALL SendName
  631.       RETURN
  632. 20318 ZOutTxt$ = "Please Switch to N,8,1 for binary transfer"
  633.       GOSUB 21630
  634.       IF ZFileSysParm > 1 THEN _
  635.          RETURN
  636.       CALL DelayTime (3)
  637.       RETURN
  638. 20320 IF NOT ZEightBit THEN _
  639.          GOSUB 20318 : _
  640.          IF ZFileSysParm > 1 THEN _
  641.             RETURN
  642. 20325 IF ZCheckSum THEN _
  643.          ZNAK$ = CHR$(21) : _
  644.          SOL = 132 _
  645.       ELSE ZNAK$ = "C" : _
  646.            SOL = 133
  647. 20330 IF ZAutoDownInProgress THEN _
  648.          RETURN
  649.       ZOutTxt$ = ZProtoPrompt$ + _
  650.             " " + WasA1$ + _
  651.             " of " + _
  652.             ZFileNameHold$ + _
  653.             " ready.  <Ctrl X> aborts"
  654.       GOSUB 21650
  655. 20335 IF ZTransferFunction = 1 THEN _
  656.          CALL Talk (8,ZOutTxt$) _
  657.       ELSE CALL Talk (9,ZOutTxt$)
  658.       RETURN
  659. '
  660. ' *  ASCII DOWNLOAD DRIVER
  661. '
  662. 20340 IF ZWasDF THEN _
  663.          ZOutTxt$ = "Switch to a non-ascii protocol" : _
  664.          GOSUB 21650 : _
  665.          GOTO 21700
  666.       GOSUB 20750
  667.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  668.          RETURN
  669.       CALL OpenWork (2,ZFileName$)
  670.       IF (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) THEN _
  671.          ZOutTxt$ = "^X aborts.  ^S suspends ^Q resumes" : _
  672.          GOSUB 21640 : _
  673.          IF ZFileSysParm > 1 THEN _
  674.             RETURN _
  675.          ELSE ZOutTxt$ = ZProtoPrompt$ + " SEND of " + _
  676.               ZFileNameHold$ + _
  677.               " ready. Press Any Key to start" : _
  678.          ZTurboKey = 2 : _
  679.          ZForceKeyboard = ZTrue : _
  680.          ZSuspendAutologoff = ZTrue : _
  681.          GOSUB 21660 : _
  682.          ZSuspendAutologoff = ZFalse : _
  683.          GOSUB 20335 : _
  684.          IF ZFileSysParm > 1 THEN _
  685.             RETURN
  686. 20380 ZStopInterrupts = ZFalse
  687.       WasTU = 0
  688.       SWAP WasTU,ZPageLength
  689.       CALL BufFile (ZFileName$,WasX)
  690.       SWAP WasTU,ZPageLength
  691.       ZNonStop = (ZPageLength < 1)
  692.       IF StopFile THEN _
  693.          DnldCompleted = ZFalse : _
  694.          GOTO 20390
  695. 20381 IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  696.          CALL QuickTPut (CHR$(26),0) : _
  697.          IF NOT ZLocalUser AND ZSubParm = 0 THEN _
  698.             FOR WasX = 1 TO 5 : _
  699.                CALL PutCom (CHR$(7)) : _
  700.                CALL DelayTime (3) : _
  701.             NEXT
  702. 20385 DnldCompleted = ZTrue
  703. 20390 GOTO 21760
  704. '
  705. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  706. '
  707. 20395 GOSUB 21640
  708.       IF ZFileSysParm > 1 THEN _
  709.          RETURN
  710.       ZOutTxt$ = "Correct name of file to upload" + _
  711.            ZPressEnterExpert$
  712.       GOSUB 21660
  713.       IF ZFileSysParm > 1 THEN _
  714.          RETURN
  715.       IF ZWasQ = 0 THEN _
  716.          RETURN
  717.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  718.       GOTO 20435
  719. 20400 CALL TimeBack (1)
  720.       GOSUB 20420
  721.       ZAutoLogOffReq = 0
  722.       FirstUpld = ZAnsIndex
  723.       GOTO 20430
  724. 20420 ZOutTxt$ = "Upload what file(s)"
  725.       ZStackC = ZTrue
  726.       GOSUB 21668
  727.       RETURN
  728. '
  729. ' *  SEARCH FOR DUPLICATE FILENAME
  730. '
  731. 20430 ZAnsIndex = ZLastIndex
  732.       GOSUB 20470
  733.       ZLastIndex = ZLastIndex + (WasX > 0)
  734.       FOR ZAnsIndex = FirstUpld TO ZLastIndex
  735.          GOSUB 20470
  736.          GOSUB 20435
  737.          IF ZFileSysParm > 1 THEN _
  738.             ZAnsIndex = ZLastIndex + 1
  739.       NEXT
  740.       ZCmdTransfer$ = ""
  741.       RETURN
  742. 20435 ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  743.       IF INSTR(ZFileNameHold$,".") = 0 THEN _
  744.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$
  745.       CALL AllCaps(ZFileNameHold$)
  746.       ZFileName$ = ZFileNameHold$
  747.       ZViolation$ = "Upload "
  748.       CALL NoPath (ZFileName$,BadFileNameIndex)
  749.       IF BadFileNameIndex THEN _
  750.          GOTO 20451
  751.       CALL BadFile (ZFileName$,BadFileNameIndex)
  752.       ON BadFileNameIndex GOTO 20440,20451,20515
  753. 20440 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount,ZTrue)
  754. 20445 IF ZOK THEN _
  755.          GOTO 20452
  756.       IF INSTR(ZFileName$,".") = 0 THEN _
  757.          GOTO 20475
  758.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  759.       WasI = 1
  760. 20447 WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".")
  761.       IF WasJ = 0 THEN _
  762.          GOTO 20475
  763.       Check$ = MID$(ZCompressedExt$,WasI,WasJ-1)
  764.       WasI = WasI + WasJ
  765. 20450 IF Extension$ <> Check$ THEN _
  766.          CALL RotorsDir (WasX$ + "." + Check$,ZSubDir$(),ZSubDirCount,ZTrue) : _
  767.          IF ZOK THEN _
  768.             GOTO 20452
  769.       GOTO 20447
  770. 20451 ZOutTxt$ = "Invalid file name <" + ZFileName$ + ">"
  771.       GOTO 20395
  772. 20452 IF ZUserSecLevel < ZOverWriteSecLevel THEN _
  773.          GOTO 20453
  774.       ZOutTxt$ = "Overwrite file (Y,[N])"
  775.       GOSUB 21660
  776.       IF ZFileSysParm > 1 THEN _
  777.          RETURN
  778.       IF NOT ZYes THEN _
  779.          GOTO 20453
  780.       ZWasZ$ = ZFileName$
  781.       CALL KillWork (ZFileName$)
  782.       IF ZErrCode <> 0 THEN _
  783.          ZWasEL = 20452 : _
  784.          GOTO 21900
  785.       GOTO 20475
  786. 20453 CLOSE 2
  787.       IF ZUserSecLevel >= ZAddDirSecurity THEN _
  788.          GOTO 20455
  789. 20454 CALL QuickTPut1 ("Thanks, but we already have " + ZFileNameHold$)
  790.       CALL UpdtCalr ("Upload duplicate " + ZFileNameHold$,1)
  791.       RETURN
  792. 20455 ZOutTxt$ = "Add new directory entry (Y,[N])"
  793.       ZTurboKey = - ZTurboKeyUser
  794.       GOSUB 21660
  795.       IF ZFileSysParm > 1 THEN _
  796.          RETURN
  797.       IF NOT ZYes THEN _
  798.          RETURN
  799.       AddingDescOnly = ZTrue
  800.       ZWasFT$ = "l"
  801.       GOSUB 20702
  802.       RETURN
  803. 20470 ' *** CHECK FOR Protocol IN FILE LIST ***
  804.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  805.       CALL AllCaps(ZWasZ$)
  806.       WasX = 0
  807.       IF LEN (ZWasZ$) = 1 THEN _
  808.          WasX = INSTR(ZDefaultXfer$,ZWasZ$) : _
  809.          IF WasX > 0 THEN _
  810.             ZAnsIndex = ZAnsIndex + 1 : _
  811.             ZCmdTransfer$ = ZWasZ$ : _
  812.             ZAutoDownInProgress = ZFalse : _
  813.             IF MID$(ZInternalEquiv$,WasX,1) = "N" THEN _
  814.                ZCmdTransfer$ = ""
  815.       RETURN
  816. 20475 ZWasZ$ = ZUpldDriveFile$
  817.       CALL FindFree
  818.       IF VAL(ZFreeSpace$) < 4096 THEN _
  819.          CALL QuickTPut1 ("No room for uploads.  Try tomorrow.") : _
  820.          ZAnsIndex = ZLastIndex + 1 : _
  821.          RETURN
  822.       ZOutTxt$ = "Upload disk has" + _
  823.            ZFreeSpace$
  824.       GOSUB 21640
  825.       IF ZFileSysParm > 1 THEN _
  826.          RETURN
  827.       ZLine25$ = "(U) " + _
  828.                  ZFileNameHold$
  829.       ZSubParm = 2
  830.       CALL Line25
  831.       ZOutTxt$ = ""
  832.       ZOK = ZTrue
  833. 20477 CALL XferType (2,ZTrue)
  834.       IF ZFF THEN _
  835.          GOTO 20500
  836.       CALL XferType (1,ZTrue)
  837.       IF ZSubParm = -1 THEN _
  838.          ZFileSysParm = 7 : _
  839.          RETURN
  840. 20500 ZTransferFunction = 2
  841.       ZAutoDownInProgress = ZFalse
  842.       GOSUB 21790
  843.       IF ZFileSysParm > 1 THEN _
  844.          RETURN
  845.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  846.          20560, _         ' ASCII UPLOAD
  847.          20542, _         ' Xmodem
  848.          20542, _         ' Xmodem CRC
  849.          20542, _         ' YMODEM
  850.          20735            ' NONE - CANCEL
  851.       GOTO 20261
  852. 20510 WasD$ = "<Esc> by SYSOP aborts"
  853.       GOSUB 21710
  854.       RETURN
  855. 20515 CALL SecViolation
  856.       IF ZDenyAccess THEN _
  857.          ZFileSysParm = 4 : _
  858.          RETURN
  859.       GOTO 20420
  860. '
  861. ' *  Xmodem/YMODEM UPLOAD DRIVER
  862. '
  863. 20542 WasA1$ = "RECEIVE"
  864.       GOSUB 20320
  865.       IF ZFileSysParm > 1 THEN _
  866.          RETURN
  867.       ZOK = ZTrue
  868.       GOSUB 20860
  869.       IF ZFileSysParm > 1 THEN _
  870.          RETURN
  871.       IF ZOK THEN _
  872.          GOTO 20700
  873.       GOTO 20730
  874. '
  875. ' *  ASCII UPLOAD
  876. '
  877. 20560 LineACK = (ZDefaultLineACK$ <> "")
  878.       IF LineACK THEN _
  879.          ZOutTxt$ = "Acknowledge each line ([Y],N)" : _
  880.          ZTurboKey = - ZTurboKeyUser : _
  881.          LineACK = NOT ZNo : _
  882.          GOSUB 21660 : _
  883.          IF ZFileSysParm > 1 THEN _
  884.             RETURN
  885.       CALL QuickTPut1 ("Transfer MUST end with a <Ctrl-K>")
  886.       CALL QuickTPut1 (ZProtoPrompt$+" RECEIVE of " + ZFileNameHold$ + " ready")
  887.       ZOK = ZFalse
  888.       XOff = ZFalse
  889.       CALL OpenOutW(ZFileName$)
  890.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  891.          ZWasEL = 20560 : _
  892.          GOTO 21900
  893.       GOSUB 20510
  894.       IF ZFileSysParm > 1 THEN _
  895.          RETURN
  896. 20600 CALL EofComm (Char)
  897.       WHILE Char <> -1
  898.          CALL Carrier
  899.          IF ZSubParm = -1 THEN _
  900.             ZFileSysParm = 7 : _
  901.             RETURN
  902.          IF NOT ZFossil THEN _
  903.             IF LOF(3) < 512 THEN _
  904.                CALL PutCom(ZXOff$) : _
  905.                XOff = ZTrue
  906. 20610    CALL FlushCom (WasX$)
  907.          IF ZSubParm = -1 THEN _
  908.             ZFileSysParm = 7 : _
  909.             RETURN
  910.          IF INSTR(WasX$,CHR$(11)) THEN _
  911.             GOTO 20650
  912.          ZOK = ZTrue
  913. 20620    CALL PrintWork (WasX$)
  914.          IF LineACK THEN _
  915.             IF INSTR(WasX$,CHR$(10)) > 0 THEN _
  916.                CALL PutCom (ZDefaultLineACK$)
  917.          IF ZErrCode <> 0 THEN _
  918.             ZWasEL = 20620 : _
  919.             GOTO 21900
  920.          WasD$ = WasX$
  921.          NumReturns = 0
  922.          GOSUB 21720
  923.          IF ZFileSysParm > 1 THEN _
  924.             RETURN
  925. 20621    CALL FindFKey
  926.          IF ZSubParm < 0 THEN _
  927.             ZFileSysParm = 2 : _
  928.             RETURN
  929.          IF ZKeyPressed$ = ZEscape$ THEN _
  930.             GOTO 20745
  931.          IF NOT ZOK THEN _
  932.             GOTO 20670
  933.       CALL EofComm (Char)
  934. 20630 WEND
  935.       CALL Carrier
  936.       IF ZSubParm = -1 THEN _
  937.          ZFileSysParm = 7 : _
  938.          RETURN
  939.       IF XOff THEN _
  940.          XOff = ZFalse : _
  941.          CALL PutCom (ZXOn$) : _
  942.          IF ZErrCode <> 0 THEN _
  943.             ZWasEL = 20630 : _
  944.             GOTO 21900
  945.       GOTO 20600
  946. 20650 WasX = INSTR(WasX$,CHR$(11))
  947.       IF WasX = 1 THEN _
  948.          IF NOT ZOK THEN _
  949.             GOTO 20730 _
  950.          ELSE GOTO 20700
  951.       CALL PrintWorkA (LEFT$(WasX$,WasX-1))
  952.       IF ZErrCode <> 0 THEN _
  953.          ZWasEL = 20650 : _
  954.          GOTO 21900
  955.       GOTO 20700
  956. 20670 ZOutTxt$ = ZXOff$ + _
  957.            "System error! Upload aborted <Ctrl-K> continues"
  958. 20675 GOSUB 21650
  959.       IF ZFileSysParm > 1 THEN _
  960.          RETURN
  961.       CALL DelayTime (3)
  962.       CALL PutCom(ZXOn$)
  963. 20680 CALL EofComm (Char)
  964.       WHILE Char <> -1
  965.          CALL FlushCom(WasX$)
  966.          IF INSTR(WasX$,CHR$(11)) THEN _
  967.             GOTO 20730
  968. 20685    CALL Carrier
  969.          IF ZSubParm = -1 THEN _
  970.             ZFileSysParm = 7 : _
  971.             RETURN
  972.       CALL EofComm (Char)
  973.       WEND
  974.       GOTO 20680
  975. '
  976. ' *  UPDATE UPLOAD DIRECTORY
  977. '
  978. 20700 GOSUB 21780
  979.       IF ZFileSysParm > 1 THEN _
  980.          RETURN
  981. 20702 CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(), ZLinesInMsg)
  982.       ZPrivateDoor = ZFalse
  983.       IF NOT ZGetExtDesc THEN _
  984.          GOTO 20710
  985.       ZMsgHeader$ = "Extended Description for " + ZFileNameHold$
  986.       ZSysopComment = ZTrue
  987.       ZMaxMsgLines = ZMaxExtendedLines
  988.       WasLL = ZRightMargin
  989.       ZRightMargin = 30 + ZMaxDescLen
  990.       ZFileSysParm = 5
  991.       RETURN
  992. 20705 ZMaxMsgLines = ZMaxMsgLinesDef
  993.       ZRightMargin = WasLL
  994.       GOTO 20702
  995. 20710 AddingDescOnly = ZFalse
  996.       IF ZBytesInFile# > 0.0 THEN _
  997.          GOTO 21770
  998. 20730 GOSUB 21780
  999.       CALL QuickTPut1 ("Upload aborted")
  1000.       ZPrivateDoor = ZFalse
  1001. 20735 CALL KillWork (ZFileName$)
  1002.       IF ZErrCode <>0 THEN _
  1003.          ZWasEL = 20736 : _
  1004.          GOTO 21900
  1005.       ZLastIndex = 0
  1006.       RETURN
  1007. '
  1008. ' *  Sysop ABORTED UPLOAD
  1009. '
  1010. 20745 ZOutTxt$ = ZXOff$ + _
  1011.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  1012.       GOTO 20675
  1013. '
  1014. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  1015. '
  1016. 20750 ZStartOfHeader$ = CHR$(1 - (ZInternalProt$ = "Y"))
  1017.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,ZFLen)
  1018. 20760 IF ZErrCode <> 0 THEN _
  1019.          CALL QuickTPut1 ("Unable to access "+ZFileNameHold$) : _
  1020.          CALL UpdtCalr ("Unable to access "+ZFileName$,2) : _
  1021.          ZOK = ZFalse : _
  1022.          ZErrCode = 0 : _
  1023.          ZBytesInFile# = 0 : _
  1024.          RETURN
  1025.       ZBytesInFile# = LOF(2)
  1026.       ZNumDnldBytes! = LOF(2)
  1027.       ZOK = ZTrue
  1028.       IF SizeOnly THEN _
  1029.          SizeOnly = ZFalse : _
  1030.          RETURN
  1031.       ZBlocksInFile# = MaxBlock
  1032.       IF ZBatchTransfer THEN _
  1033.          Temp# = BatchBlocks# + ZBlocksInFile# : _
  1034.          CALL CheckTimeRemain (MinsRemaining) : _
  1035.          IF (NOT PersonalDnld) AND _
  1036.             (INT(Temp# / 60) + 1 > MinsRemaining) THEN _
  1037.             CALL QuickTPut1 ("Omitting " + ZFileNameHold$ + ".  Insufficient time") : _
  1038.             RETURN _
  1039.          ELSE BatchBlocks# = Temp# : _
  1040.               BatchBytes# = BatchBytes# + ZBytesInFile# : _
  1041.               CALL OpenWorkA (ZNodeWorkFile$) : _
  1042.               CALL PrintWorkA (ZFileName$) : _
  1043.               ZDownFiles = ZDownFiles + 1 : _
  1044.               RETURN
  1045.       ZDownFiles = 1
  1046. 20780 ZOutTxt$ = "File Size    :"
  1047.       ZOK = ZTrue
  1048.       IF ZBlockSize > 0 THEN _
  1049.          ZOutTxt$ = ZOutTxt$ + _
  1050.               STR$(FIX(ZBlocksInFile#)) + _
  1051.               " blocks "
  1052. 20785 ZBlocksInFile# = ZBlocksInFile# / _
  1053.                         VAL(MID$("00000300045012002400480096019203840", -4 * ZBPS, 4))
  1054.       ZBlocksInFile# = ZBlocksInFile# * ZFLen / ZSpeedFactor!
  1055.       IF (ZAnsIndex > 1 AND ZConcatFIles) THEN _
  1056.          RETURN
  1057.       ZOutTxt$ = ZOutTxt$ + _
  1058.            STR$(ZBytesInFile#) + _
  1059.            " bytes"
  1060.       GOSUB 21650
  1061.       IF ZFileSysParm > 1 THEN _
  1062.          RETURN
  1063.       IF ZBytesInFile# < 1 THEN _
  1064.          RETURN
  1065. 20790 ZSubParm = 2
  1066.       CALL Line25
  1067.       ZOutTxt$ = "Transfer Time:" + _
  1068.          STR$(INT(ZBlocksInFile# / 60)) + _
  1069.          " min," + _
  1070.          STR$(INT(ZBlocksInFile# - (INT(ZBlocksInFile# / 60) * 60))) + _
  1071.          " sec (approx)"
  1072.       GOSUB 21650
  1073.       IF ZFileSysParm > 1 THEN _
  1074.          RETURN
  1075. 20791 IF PersonalDnld THEN _
  1076.          RETURN
  1077.       CALL CheckTimeRemain (MinsRemaining)
  1078.       IF ZSubParm = -1 THEN _
  1079.          ZFileSysParm = 6 : _
  1080.          RETURN
  1081.       ZOK = ZTrue
  1082.       IF (INT(ZBlocksInFile# / 60) + 1) > MinsRemaining THEN _
  1083.          ZOutTxt$ = "Not enough time left!" : _
  1084.          CALL UpdtCalr (ZFileName$ + " " + ZOutTxt$,2) : _
  1085.          CALL QuickTPut1 (ZOutTxt$): _
  1086.          ZOutTxt$ = "" : _
  1087.          ZOK = ZFalse : _
  1088.          ZAutoLogoffReq = ZFalse : _
  1089.          RETURN
  1090.       IF ZRatioRestrict# > 0 THEN _
  1091.          CALL QuickTPut1 ("New statistics will be") : _
  1092.          CALL CheckRatio (ZTrue)
  1093.       RETURN
  1094. 20810 ZDelay! = TIMER + 6
  1095. 20840 CALL EofComm (Char)
  1096.       IF Char = -1 THEN _
  1097.          GOTO 20850
  1098.       CALL FlushCom(ZWasY$)
  1099.       RETURN
  1100. 20850 CALL CheckTime (ZDelay!, TempElapsed!, 1)
  1101.       IF TempElapsed! > 0 THEN GOTO 20840
  1102. 20851 ZWasY$ = ""
  1103.       CALL CheckCarrier
  1104.       IF ZSubParm = -1 THEN _
  1105.          ZFileSysParm = 7 : _
  1106.          RETURN
  1107.       RETURN
  1108. '
  1109. ' *  Xmodem/YMODEM UPLOAD
  1110. '
  1111. 20860 GOSUB 20992
  1112.       IF ZFileSysParm > 1 THEN _
  1113.          RETURN
  1114.       IF NOT ZEightBit THEN _
  1115.          GOSUB 21280 : _
  1116.          IF ZFileSysParm > 1 THEN _
  1117.             RETURN
  1118. 20900 WasX$ = ""
  1119.       Sec = 1
  1120.       'CALL OpenOutW (ZFileName$)
  1121.       IF ZFLen > ZWriteBufDef THEN _
  1122.          WriteBuf = ZFLen _
  1123.       ELSE WriteBuf = ZWriteBufDef
  1124.       CALL OpenRSeq (ZFileName$,WasY,ZWasDF,WriteBuf)
  1125.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  1126.          ZWasEL = 20900 : _
  1127.          GOTO 21900
  1128.       FIELD #2, WriteBuf AS ZUpldRec$
  1129.       RecsWrit = 0
  1130.       NumInBuff = 0
  1131.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1132.       Year$ = " " + _
  1133.             CHR$(1) + _
  1134.             CHR$(2) + _
  1135.             ZEndTransmission$ + _
  1136.             ZCancel$
  1137. 20903 CALL PutCom (ZNAK$)
  1138. 20920 WasX = 1
  1139. 20922 CALL CheckCarrier
  1140.       IF ZSubParm = -1 THEN _
  1141.          ZFileSysParm = 7 : _
  1142.          RETURN
  1143.       CALL FindFKey
  1144.       IF ZKeyPressed$ = ZEscape$ THEN _
  1145.          GOSUB 20510 :_
  1146.          IF ZFileSysParm > 1 THEN _
  1147.             RETURN _
  1148.          ELSE GOTO 21240
  1149.       GOSUB 20810
  1150.       IF ZFileSysParm > 1 THEN _
  1151.          RETURN
  1152. 20930 WasJ = INSTR(Year$,LEFT$(ZWasY$,1))
  1153.       ON WasJ GOTO 20960,20999,20999,21220,21230
  1154. 20960 IF ZWasY$ <> "" THEN _
  1155.          GOSUB 21280 : _
  1156.          IF ZFileSysParm > 1 THEN _
  1157.             RETURN _
  1158.          ELSE CALL CheckTime (TransferAbort!,TempElapsed!,1) : _
  1159.               ON ZSubParm GOTO 20920,21230
  1160. 20970 WasX = WasX + 1
  1161.       CALL DelayTime (1)
  1162.       CALL PutCom (ZNAK$)
  1163.       IF WasX < 6 THEN _
  1164.          GOTO 20922
  1165.       WasD$ = "Upload Timeout"
  1166.       GOSUB 21710
  1167.       IF ZFileSysParm > 1 THEN _
  1168.          RETURN
  1169.       CALL CheckTime (TransferAbort!,TempElapsed!,1)
  1170.       ON ZSubParm GOTO 20990,21230
  1171. 20990 GOTO 20920
  1172. '
  1173. ' *  CHANGE TO 8 BIT FOR Xmodem
  1174. '
  1175. 20992 GOSUB 20510
  1176.       IF ZFileSysParm > 1 THEN _
  1177.          ZFileSysParm = 2 : _
  1178.          RETURN
  1179.       IF NOT ZEightBit THEN _
  1180.          PrevLineCntl = INP (ZLineCntlReg) : _
  1181.          CALL DelayTime (3) : _
  1182.          SwitchToEight = ZTrue : _
  1183.          OUT ZLineCntlReg,3
  1184. 20996 WasSO = 0
  1185.       RETURN
  1186. '
  1187. ' *  EXPECTED BLOCK LENGTH. 132 FOR CheckSum, 133 FOR CRC, 1029 FOR YMODEM
  1188. '
  1189. 20999 SOL = 896 * WasJ - 1659 + ZCheckSum
  1190.       DataSol = 128 - (SOL > 1024)*896
  1191.       GOTO 21020
  1192. '
  1193. ' *  Xmodem/YMODEM UPLOAD
  1194. '
  1195. 21000 GOSUB 20810
  1196.       IF ZFileSysParm > 1 THEN _
  1197.          RETURN
  1198.       IF ZWasY$ = "" THEN _
  1199.          WasD$ = "Upload Timeout" : _
  1200.          GOSUB 21710 : _
  1201.          IF ZFileSysParm > 1 THEN _
  1202.             RETURN _
  1203.          ELSE GOTO 21040
  1204. 21020 WasX$ = WasX$ + _
  1205.            ZWasY$
  1206.       IF LEN(WasX$) < SOL THEN _
  1207.          GOTO 21000
  1208. 21040 IF LEN(WasX$) = SOL THEN _
  1209.          GOTO 21090
  1210. 21050 IF LEN(WasX$) > SOL THEN _
  1211.          GOTO 21180
  1212. 21060 IF WasX$ = ZEndTransmission$ THEN _
  1213.          GOTO 21220
  1214. 21070 IF WasX$ = ZCancel$ THEN _
  1215.          GOTO 21230
  1216. 21080 GOTO 21170
  1217. 21090 WasJX = ASC(MID$(WasX$,2,1))
  1218.       IF Sec = WasJX THEN _
  1219.          GOTO 21100
  1220.       GOTO 21200
  1221. 21100 IF (Sec XOR 255) <> ASC(MID$(WasX$,3,1)) THEN _
  1222.          GOTO 21210
  1223. 21110 IF ZCheckSum THEN _
  1224.          WasWK$ = MID$(WasX$,4,128) : _
  1225.          GOSUB 21750 : _
  1226.          IF ZFileSysParm > 1 THEN _
  1227.             RETURN _
  1228.          ELSE IF XmodemChecksum <> ASC(MID$(WasX$,132,1)) THEN _
  1229.             GOTO 21190 _
  1230.          ELSE GOTO 21120
  1231.       WasWK$ = MID$(WasX$,4)
  1232.       GOSUB 21750
  1233.       IF ZFileSysParm > 1 THEN _
  1234.          RETURN
  1235. 21113 IF CRCValue <> 0 THEN _
  1236.          GOTO 21191
  1237. 21120 WasSO = WasSO + 1
  1238.       CALL PutCom (ZAcknowledge$)
  1239. 21131 IF NumInBuff >= WriteBuf THEN _
  1240.          NumInBuff = 0 : _
  1241.          CALL PutWork (ZUpldRec$,RecsWrit,WriteBuf) : _
  1242.          IF ZErrCode <> 0 THEN _
  1243.             ZWasEL = 21131 : _
  1244.             GOTO 21900
  1245.       MID$(ZUpldRec$,NumInBuff+1,DataSol) = WasWK$
  1246.       NumInBuff = NumInBuff + DataSol
  1247. 21145 Sec = 255 AND (Sec + 1)
  1248.       CALL QuickLPrnt ("OK Rec Blk #",WasSO)
  1249. 21150 WasX$ = ""
  1250.       XmodemChecksum = 0
  1251.       TransferAbort! = TIMER + 45
  1252.       GOTO 20920
  1253. 21170 ZOutTxt$ = "Short Blk #"
  1254.       GOTO 21212
  1255. 21180 ZOutTxt$ = "Long Blk #"
  1256.       GOTO 21212
  1257. 21190 ZOutTxt$ = "Chksum Error #"
  1258.       GOTO 21212
  1259. 21191 ZOutTxt$ = "CRC Error"
  1260.       GOTO 21212
  1261. 21200 IF Sec < WasJX THEN _
  1262.          ZOutTxt$ = "Blk # Error in #" : _
  1263.          GOTO 21212
  1264.       CALL PutCom (RIGHT$(ZAckChar$,1 - (WasJX = 0)))
  1265.       GOTO 21150
  1266. 21210 ZOutTxt$ = "Complement Error in #"
  1267. 21212 CALL PutCom (ZNAK$)
  1268.       CALL LPrnt(ZLineFeed$ + ZOutTxt$ + STR$(WasSO + 1),0)
  1269.       GOTO 21150
  1270. 21220 IF NumInBuff < 1 THEN _
  1271.          GOTO 21225
  1272.       WasWK$ = LEFT$(ZUpldRec$,NumInBuff)
  1273.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,128)
  1274.       FIELD #2, 128 AS ZUpldRec$
  1275.       MaxBlock = CDBL(RecsWrit) * WriteBuf / 128
  1276.       FOR WasI = 1 TO NumInBuff/128
  1277.          CALL PutWork (MID$(WasWK$,128*WasI-127,128),MaxBlock,128)
  1278.          IF ZErrCode > 0 THEN _
  1279.             ZWasEL = 21220 : _
  1280.             GOTO 21900
  1281.       NEXT
  1282.       CLOSE 2
  1283. 21225 CALL PutCom (ZAcknowledge$)
  1284.       GOTO 21250
  1285. 21230 WasD$ = ZLineFeed$ + _
  1286.            "Transfer Aborted"
  1287.       GOSUB 21710
  1288.       IF ZFileSysParm > 1 THEN _
  1289.          RETURN
  1290. 21240 CALL EofComm (Char)
  1291.       IF Char <> -1 THEN _
  1292.          GOSUB 21280 : _
  1293.          IF ZFileSysParm > 1 THEN _
  1294.             RETURN _
  1295.          ELSE CALL DelayTime (1) : _
  1296.          GOTO 21240
  1297.       CALL PutCom (ZCancel$ + ZCancel$)
  1298.       CALL DelayTime (1)
  1299.       CALL EofComm (Char)
  1300.       IF Char <> -1 THEN _
  1301.          GOTO 21240
  1302.       ZOK = ZFalse
  1303. 21250 ZEightBit = ZTrue
  1304.       RETURN
  1305. '
  1306. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1307. '
  1308. 21280 CALL CheckCarrier
  1309.       IF ZSubParm = -1 THEN _
  1310.          ZFileSysParm = 7 : _
  1311.          RETURN
  1312.       CALL EofComm (Char)
  1313.       IF Char = -1 THEN _
  1314.          RETURN
  1315. 21281 CALL FlushCom(ZWasDF$)
  1316.       'IF ZSubParm = -1 THEN _
  1317.       '   ZFileSysParm = 7 : _
  1318.       '   RETURN
  1319.       GOTO 21280
  1320. '
  1321. ' *  Xmodem/YMODEM DOWNLOAD
  1322. '
  1323. 21300 GOSUB 20992
  1324.       IF ZFileSysParm > 1 THEN _
  1325.          RETURN
  1326.       Sec = 0
  1327.       GOSUB 21280
  1328.       IF ZFileSysParm > 1 THEN _
  1329.          RETURN
  1330.       ZNAK$ = CHR$(21)
  1331.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1332. 21303 FIELD 2,ZFLen AS ZDnldRecord$
  1333. '
  1334. ' *  ROUTINE TO START AN "Xmodem" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1335. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1336. ' *           "X" = Xmodem WITH CheckSum AND 128 CHARACTER RECORDS
  1337. ' *           "C" = Xmodem WITH CRC CHECK AND 128 CHARACTER RECORDS
  1338. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1339. '
  1340. 21350 CALL EofComm (Char)
  1341.       WHILE Char <> -1
  1342. 21360    CALL GetCom(ZWasY$)
  1343.          IF ZWasY$ = ZCancel$ THEN _
  1344.             GOTO 21560
  1345. 21380    ZCheckSum = (ZWasY$ = ZNAK$)
  1346.          IF ZCheckSum THEN _
  1347.             ZFF = INSTR(ZInternalEquiv$,"X") : _
  1348.             IF ZFF > 0 THEN _
  1349.                ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) : _
  1350.                GOTO 21480 _
  1351.             ELSE ZWasFT$ = "X" : _
  1352.                  GOTO 21480 _
  1353.          ELSE IF ZWasY$ = "C" THEN _
  1354.                  GOTO 21480
  1355.          CALL EofComm (Char)
  1356. 21390 WEND
  1357.       GOSUB 21460
  1358.       IF ZFileSysParm > 1 THEN _
  1359.          RETURN
  1360.       IF ZKeyPressed$ = ZEscape$ THEN _
  1361.          RETURN
  1362.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1363.       ON ZSubParm GOTO 21350,21455
  1364. 21410 TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1365. '
  1366. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "Xmodem" OR "YMODEM"
  1367. ' *  DOWNLOAD
  1368. '
  1369. 21415 CALL EofComm (Char)
  1370.       IF Char <> -1 THEN _
  1371.          GOTO 21420
  1372.       GOSUB 21460
  1373.       IF ZFileSysParm > 1 THEN _
  1374.          RETURN
  1375.       IF ZKeyPressed$ = ZEscape$ THEN _
  1376.          RETURN
  1377.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1378.       ON ZSubParm GOTO 21415,21455
  1379. 21420 CALL GetCom(ZWasY$)
  1380.       IF ZWasY$ = ZAcknowledge$ THEN _
  1381.          GOTO 21470
  1382. 21440 IF ZWasY$ <> ZNAK$ THEN _
  1383.          GOTO 21450
  1384. 21443 WasD$ = ZLineFeed$ + _
  1385.          "Error -> retrans #" + _
  1386.          STR$(WasSO)
  1387.       GOSUB 21710
  1388.       IF ZFileSysParm > 1 THEN _
  1389.          RETURN
  1390. 21445 WasSO = WasSO - 1
  1391.       GOTO 21490
  1392. 21450 IF ZWasY$ = ZCancel$ THEN _
  1393.          IF HaveACancel THEN _
  1394.             GOTO 21560 _
  1395.          ELSE HaveACancel = ZTrue
  1396.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1397.       ON ZSubParm GOTO 21415,21455
  1398. 21455 WasD$ = "Download timeout"
  1399.       GOSUB 21710
  1400.       IF ZFileSysParm > 1 THEN _
  1401.          RETURN
  1402.       GOTO 21560
  1403. 21460 CALL CheckCarrier
  1404.       CALL FindFKey
  1405.       IF ZSubParm < 0 THEN _
  1406.          ZFileSysParm = 7 : _
  1407.          RETURN
  1408.       IF ZKeyPressed$ = ZEscape$ THEN _
  1409.          GOTO 21540
  1410.       RETURN
  1411. '
  1412. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1413. '
  1414. 21470 CALL QuickLPrnt ("OK Sent Blk #",WasSO)
  1415. 21480 IF LOC(2) => MaxBlock THEN _
  1416.          GOTO 21530
  1417.       CALL GetWork (ZFLen)
  1418.       IF ZErrCode <> 0 THEN _
  1419.          ZWasEL = 21480 : _
  1420.          GOTO 21900
  1421.       Sec = 255 AND (Sec + 1)
  1422.       GOTO 21490
  1423. '
  1424. ' *  ROUTINE TO WRITE OUT AN "Xmodem" OR "YMODEM" RECORD TO THE COMM. PORT
  1425. '
  1426. 21490 WasSO = WasSO + 1
  1427.       CALL PutCom (ZStartOfHeader$ + CHR$(Sec) + CHR$(Sec XOR 255))
  1428.       CALL PutCom (ZDnldRecord$)
  1429.       HaveACancel = ZFalse
  1430. 21503 WasWK$ = ZDnldRecord$
  1431. 21504 GOSUB 21750
  1432.       IF ZFileSysParm > 1 THEN _
  1433.          RETURN
  1434. 21510 IF ZCheckSum THEN _
  1435.          CALL PutCom(CHR$(XmodemChecksum)) _
  1436.       ELSE CALL PutCom(CHR$(CRCHigh) + CHR$(CRCLow))
  1437.       GOSUB 21280
  1438.       IF ZFileSysParm > 1 THEN _
  1439.          RETURN
  1440.       GOTO 21410
  1441. '
  1442. ' *  END-OF-FILE FOR Xmodem Dnlds -- SEND THE "EOT" CHARACTER AND WAIT UP
  1443. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1444. ' *  RE-TRY UP TO 10 TIMES.  IF No POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1445. ' *  Attempts, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1446. '
  1447. 21530 CALL PutCom (ZEndTransmission$)
  1448.       WasX = 1
  1449. 21531 GOSUB 20810
  1450.       IF ZFileSysParm > 1 THEN _
  1451.          RETURN
  1452.       IF INSTR(ZWasY$,ZAcknowledge$) THEN _
  1453.          GOTO 21550
  1454.       CALL FindFKey
  1455.       IF ZSubParm < 0 THEN _
  1456.          ZFileSysParm = 2 : _
  1457.          RETURN
  1458.       IF ZKeyPressed$ = ZEscape$ THEN _
  1459.          GOSUB 21540 : _
  1460.          GOTO 21545
  1461.       IF WasX < 10 THEN _
  1462.          WasX = WasX + 1 : _
  1463.          GOTO 21531
  1464.       DnldCompleted = ZFalse
  1465.       GOTO 21230
  1466. 21540 GOSUB 20510
  1467.       IF ZFileSysParm > 1 THEN _
  1468.          RETURN
  1469.       RETURN
  1470. 21545 ZWasY$ = ZCancel$
  1471.       CALL PutCom (ZCancel$ + ZCancel$ + ZCancel$)
  1472.       DnldCompleted = ZFalse
  1473.       GOTO 21250
  1474. 21550 DnldCompleted = ZTrue
  1475.       GOTO 21250
  1476. 21560 DnldCompleted = ZFalse
  1477.       WasD$ = ZLineFeed$ + _
  1478.            "Caller aborted trans"
  1479.       GOSUB 21710
  1480.       IF ZFileSysParm > 1 THEN _
  1481.          RETURN
  1482.       GOTO 21545
  1483. '
  1484. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1485. '
  1486. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1487. 21630 ZSubParm = 1
  1488.       GOTO 21655
  1489. 21640 ZSubParm = 3
  1490.       GOTO 21655
  1491. 21650 ZSubParm = 5
  1492. 21655 CALL TPut
  1493.       IF ZSubParm < 0 THEN _
  1494.          ZFileSysParm = 2 : _
  1495.          RETURN
  1496.       IF ZSubParm = 8 THEN _
  1497.          GOSUB 21660
  1498.       RETURN
  1499. '
  1500. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1501. '
  1502. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1503. 21660 ZSubParm = 1
  1504.       CALL TGet
  1505. 21665 IF ZSubParm < 0 THEN _
  1506.          ZFileSysParm = 2
  1507.       RETURN
  1508. 21668 CALL PopCmdStack
  1509.       GOTO 21665
  1510. 21700 ZErrCode = 0
  1511.       ZLastIndex = 0
  1512.       RETURN
  1513. '
  1514. ' **** COMMON LOCAL DISPLAY PRINT ***
  1515. '
  1516. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS
  1517. 21710 NumReturns = 1
  1518. 21720 CALL LPrnt (WasD$,NumReturns)
  1519.       RETURN
  1520. '
  1521. ' *  Xmodem / CRC INTERFACE
  1522. '
  1523. '  (formerly line 46000 in RBBS-PC.BAS
  1524. 21750 XmodemChecksum = 0
  1525.       CRCValue = 0
  1526.       CALL Xmodem(WasWK$,XmodemChecksum,CRCValue,CRCHigh,CRCLow)
  1527.       RETURN
  1528. '
  1529. ' * UPDATE DOWNLOAD STATISTICS
  1530. '
  1531. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS
  1532. 21760 GOSUB 21780
  1533.       IF ZFileSysParm > 1 THEN _
  1534.          RETURN
  1535.       IF ZBatchTransfer THEN _
  1536.          CALL LinesInFile (ZNodeWorkFile$,ZDownFiles) _
  1537.       ELSE ZDownFiles = 1
  1538.       IF NOT DnldCompleted THEN _
  1539.          ZAutoLogoffReq = ZFalse : _
  1540.          ZWasDF$ = " Aborted" : _
  1541.          GOTO 21768
  1542.       CALL LogPDown (PersonalDnld,1+ZAnsIndex-FirstDnld)
  1543.       WasX = ((ZRatioRestrict# = 0) AND ZEnforceRatios)
  1544.       IF NOT WasX THEN _
  1545.          ZDnlds = ZDnlds + ZDownFiles : _
  1546.          ZGlobalDLToday! = ZGlobalDLToday! + ZDownFiles : _
  1547.          ZGlobalDnlds = ZGlobalDnlds + ZDownFiles : _
  1548.          ZDLBytes! = ZDLBytes! + ZNumDnldBytes! : _
  1549.          ZGlobalDLBytes! = ZGlobalDLBytes! + ZNumDnldBytes! : _
  1550.          ZDLToday! = ZDLToday! + ZDownFiles : _
  1551.          ZBytesToday! = ZBytesToday! + ZNumDnldBytes! : _
  1552.          ZGlobalBytesToday! = ZGlobalBytesToday! + ZNumDnldBytes!
  1553.       ZNumDnldBytes! = 0
  1554.       CALL Muzak (6)
  1555.       ZWasDF$ = " Downloaded"
  1556.       IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  1557.          CALL SkipLine (1) : _
  1558.          CALL QuickTPut1 ("Download successful") : _
  1559.          IF WasX THEN _
  1560.             CALL QuickTPut1 ("but not counted against ratios")
  1561. 21768 IF ZAutoDownInProgress THEN _
  1562.          ZWasDF$ = " AUTO" + _
  1563.               MID$(ZWasN$,2)
  1564.       IF INSTR(ZWasN$,"Aborted") THEN _
  1565.          ZAutoDownInProgress = 0
  1566.       ZOutTxt$ = ""
  1567. 21770 CALL AMorPM
  1568.       IF NOT ZBatchTransfer THEN _
  1569.          GOTO 21773
  1570.       CALL OpenWork (2,ZNodeWorkFile$)
  1571.       IF ZErrCode > 0 THEN _
  1572.          RETURN
  1573.       ZWasQ = 0
  1574.       WHILE NOT EOF(2)
  1575.          CALL ReadAny
  1576.          ZWasQ = ZWasQ + 1
  1577.          ZUserIn$(ZWasQ) = ZOutTxt$
  1578.       WEND
  1579. 21772 IF ZWasQ < 1 THEN _
  1580.          ZBatchTransfer = ZFalse : _
  1581.          RETURN
  1582.       CALL OpenWork (2,ZUserIn$(ZWasQ))
  1583.       IF ZErrCode > 0 THEN _
  1584.          ZErrCode = 0 : _
  1585.          ZWasQ = ZWasQ - 1 : _
  1586.          GOTO 21772
  1587.       ZBytesInFile# = LOF(2)
  1588.       ZFileName$ = ZUserIn$(ZWasQ)
  1589. 21773 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  1590.       ZWasZ$ = WasX$ + _
  1591.            Extension$ + _
  1592.            ZWasDF$ + _
  1593.            " at " + _
  1594.            ZTime$ + _
  1595.            " using " + _
  1596.            ZWasFT$ + _
  1597.            STR$(ZBytesInFile#)
  1598.       CALL UpdtCalr (ZWasZ$,2)
  1599.       IF ZBatchTransfer THEN _
  1600.          ZWasQ = ZWasQ - 1 : _
  1601.          GOTO 21772
  1602.       'CALL CheckRatio (ZFalse)
  1603. 21774 IF ZMenuIndex = 6 THEN _
  1604.          IF DnldCompleted THEN _
  1605.             ZOutTxt$ = WasX$ : _
  1606.             ZSubParm = 5 : _
  1607.             CALL Library
  1608.       RETURN
  1609. '
  1610. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1611. '
  1612. '  (formerly line 50620 in RBBS-PC.BAS
  1613. 21780 IF ZEchoer$ = "I" THEN _
  1614.          CALL SetEcho ("I")
  1615. '
  1616. ' *  RESTORE COMMUNICATIONS AFTER Switch TO 8 BIT
  1617. '
  1618. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS
  1619.       IF SwitchToEight THEN _
  1620.          IF ZSwitchBack THEN _
  1621.             OUT ZLineCntlReg, PrevLineCntl : _
  1622.             CALL DelayTime (3) : _
  1623.             ZEightBit = ZFalse : _
  1624.             SwitchToEight = ZFalse
  1625.       RETURN
  1626. '
  1627. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1628. '
  1629. '  (formerly line 50630 in RBBS-PC.BAS
  1630. 21790 IF ZEchoer$ = "I" THEN _
  1631.          CALL SetEcho ("R")
  1632.       RETURN
  1633. '
  1634. ' *****   DIRECTORY SEARCH   ****
  1635. '
  1636. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS
  1637. 21800 WasCK = 2
  1638. 21810 ZOutTxt$ = "Search for (in file name/desc, wildcards name only, [ENTER] quits)"
  1639.       ZMacroMin = 99
  1640.       GOSUB 21668
  1641.       IF ZWasQ = 0 THEN _
  1642.          RETURN
  1643. 21820 WasRS$ = ZUserIn$(ZAnsIndex)
  1644.       WildSearch = (INSTR(WasRS$,"*") > 0 OR INSTR(WasRS$,"?") > 0)
  1645.       CALL AllCaps (WasRS$)
  1646.       SearchString$ = WasRS$
  1647.       SearchDate$ = ""
  1648.       ZJumpSearching = ZFalse
  1649.       WasA1$ = WasRS$
  1650.       GOTO 21867
  1651. '
  1652. ' *****  WasP - personal download  ****
  1653. '
  1654. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS
  1655. 21850 IF ZPersonalBegin < 1 OR ZPersonalLen < 1 THEN _
  1656.          RETURN
  1657.       DnldFlag = 0
  1658.       PersonalDnld = ZTrue
  1659. 21852 CALL PersFile (MID$(ZUserRecord$,ZPersonalBegin,ZPersonalLen),_
  1660.                      DnldFlag)
  1661.       IF ZSubParm = -1 THEN _
  1662.          ZFileSysParm = 7: _
  1663.          RETURN
  1664.       IF ZLastIndex <= 0 THEN _
  1665.          GOTO 21854
  1666.       ZConcatFIles = ZPersonalConcat
  1667.       ZStopInterrupts = ZTrue
  1668.       TimeLockExempt = ZTrue
  1669.       GOSUB 20202
  1670.       IF ZFileSysParm > 1 THEN _
  1671.          GOTO 21854
  1672.       TimeLockExempt = ZFalse
  1673.       ZConcatFIles = ZFalse
  1674.       GOTO 21852
  1675. 21854 PersonalDnld = ZFalse
  1676.       RETURN
  1677. '
  1678. ' *  WasN - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE Last DIR DISPLAY)
  1679. '
  1680. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS
  1681. 21860 WasCK = 1
  1682. 21862 WasA1$ = RIGHT$(ZWasLM$,4) +_
  1683.             LEFT$(ZWasLM$,2)
  1684.       ZOutTxt$ = "Files on/after MMDDYY, [ENTER] = " + WasA1$
  1685.       GOSUB 21668
  1686.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  1687.       IF ZWasQ = 0 OR ZUserIn$(ZAnsIndex) = "S" THEN _
  1688.          WasRS$ = ZWasLM$ : _
  1689.          GOTO 21866
  1690. 21865 IF LEN(ZUserIn$(ZAnsIndex)) <> 6 THEN _
  1691.          GOTO 21862
  1692.       WasA1$ = ZUserIn$(ZAnsIndex)
  1693.       WasRS$ = RIGHT$(WasA1$,2) + _
  1694.             LEFT$(WasA1$,4)
  1695.       ListNew = ZTrue
  1696. 21866 SearchDate$ = WasRS$
  1697.       SearchString$ = ""
  1698.       ZJumpSearching = ZFalse
  1699. 21867 CALL GetDirs (NOT ZExpertUser)
  1700.       IF ZWasQ = 0 THEN _
  1701.          RETURN
  1702. 21871 CALL ConvertDir (ZAnsIndex)
  1703.       ZListDir = ZTrue
  1704.       ListNew = ZTrue
  1705.       ZSearchingAll = ZFalse
  1706. 21875 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1707.       IF NOT ZSearchingAll THEN _
  1708.          IF ZWasZ$ = "ALL" THEN _
  1709.             IF NOT ZLimitSearchToFMS THEN _
  1710.                GOSUB 21890
  1711. 21880 WasQX = ZAnsIndex
  1712.       GOSUB 20157
  1713.       IF ZFileSysParm > 1 THEN _
  1714.          RETURN
  1715.       ZAnsIndex = ZAnsIndex + 1
  1716.       IF ZAnsIndex <= ZLastIndex THEN _
  1717.          GOTO 21875
  1718.       ListNew = ZFalse
  1719.       SearchString$ = ""
  1720.       SearchDate$ = ""
  1721.       RETURN
  1722. 21890 WasG = ZAnsIndex
  1723.       CALL GetAll (ZUserIn$(),WasG)
  1724.       ZSearchingAll = ZTrue
  1725.       ZLastIndex = WasG
  1726.       ZAnsIndex = ZAnsIndex + 1
  1727.       RETURN
  1728. '
  1729. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1730. '
  1731. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS
  1732. 21900 IF ZDebug THEN _
  1733.          ZOutTxt$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1734.               STR$(ZWasEL) + _
  1735.               " ERR=" + _
  1736.               STR$(ZErrCode) : _
  1737.          IF ZPrinter THEN _
  1738.             CALL Printit(ZOutTxt$) _
  1739.          ELSE CALL LPrnt(ZOutTxt$,1)
  1740.       IF ZWasEL = 20126 AND ZErrCode = 53 THEN _
  1741.          GOTO 20142
  1742.       IF ZWasEL = 20242 AND ZErrCode = 62 THEN _
  1743.          CALL UpdtCalr (ZFileSecFile$ + " bad format!",2) : _
  1744.          GOTO 20247
  1745.       IF ZWasEL = 20263 THEN _
  1746.          ZOutTxt$ = "<Download aborted>" : _
  1747.          DnldCompleted = ZFalse : _
  1748.          GOTO 20390
  1749.       IF ZWasEL = 20452 AND ZErrCode = 53 THEN _
  1750.          GOTO 20451
  1751.       IF ZWasEL = 20560 AND ZErrCode = 67 THEN _
  1752.          GOTO 20451
  1753.       IF ZWasEL = 20560 AND ZErrCode = 70 THEN _
  1754.          IF VAL(ZFreeSpace$) > 1999 THEN _
  1755.             GOTO 20610 _
  1756.          ELSE CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1757.               GOTO 21700
  1758.       IF ZWasEL = 20620 THEN _
  1759.          GOTO 20670
  1760.       IF ZWasEL = 20650 THEN _
  1761.          GOTO 20670
  1762.       IF ZWasEL = 20736 AND ZErrCode = 53 THEN _
  1763.          GOTO 21700
  1764.       IF ZWasEL = 20900 AND ZErrCode = 75 THEN _
  1765.          GOTO 21230
  1766.       IF ZWasEL = 20900 AND ZErrCode = 70 THEN _
  1767.          CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1768.          GOTO 21230
  1769.       IF ZWasEL = 21131 OR ZWasEL = 21220 THEN _
  1770.          ZErrCode = 0 : _
  1771.          GOTO 21230
  1772.       IF ZWasEL = 21480 THEN _
  1773.          CALL LogError : _
  1774.          IF ZErrCode = 57 THEN _
  1775.             CALL QuickTPut1 ("Error reading file.  Aborting download") : _
  1776.             DnldCompleted = ZFalse : _
  1777.             GOTO 21230
  1778. 21910 CALL LogError
  1779.       CALL QuickTPut1 (ZCallersRecord$)
  1780.       ZFileSysParm = 3
  1781.       RETURN
  1782. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1783.       END SUB
  1784. 63100 ' $SUBTITLE: 'DoorReturn - Subroutine to process requests from a door'
  1785. ' $PAGE
  1786. '
  1787. '  NAME    -- DoorReturn
  1788. '
  1789. '  INPUTS  -- PARAMETER                      MEANING
  1790. '             DOUTx.DEF               File of requests
  1791. '
  1792. '  OUTPUTS -- ZUserSecLevel     Revised Security Level
  1793. '
  1794. '  PURPOSE -- To give Doors a stable way to make requests
  1795. '             to the host.
  1796. '
  1797.       SUB DoorReturn STATIC
  1798.       IF ZPrivateDoor OR NOT ZExitToDoors THEN _
  1799.          EXIT SUB
  1800.       ZFileName$ = "DOUT" + ZNodeID$ + ".DEF"
  1801.       CALL FindIt (ZFileName$)
  1802.       IF NOT ZOK THEN _
  1803.          EXIT SUB
  1804. 63105 IF EOF(2) THEN _
  1805.          GOTO 63195
  1806.       CALL ReadParms (ZOutTxt$(),2,1)
  1807.       IF ZErrCode > 0 THEN _
  1808.          GOTO 63115
  1809.       IF LEN(ZOutTxt$(1)) < 2 THEN _
  1810.          EXIT SUB
  1811.       ZUserIn$ = LEFT$(ZOutTxt$(1),2) + ","
  1812.       WasX = INSTR("SL,UR,",ZUserIn$)
  1813.       IF WasX = 0 THEN _
  1814.          GOTO 63105
  1815.       WasX = WasX\3 + 1
  1816.       ON WasX GOTO 63110,63115
  1817.       GOTO 63105
  1818. 63110 WasX$ = LEFT$(ZOutTxt$(2),1)         ' ZWasSL = Security Level
  1819.       CALL CheckInt (ZOutTxt$(2))
  1820.       IF ZErrCode > 0 THEN _
  1821.          GOTO 63105
  1822.       IF WasX$ = "+" OR WasX$ = "-" THEN _
  1823.          ZWasA = ZUserSecLevel + ZTestedIntValue _
  1824.       ELSE ZWasA = ZTestedIntValue
  1825.       IF ZWasA < ZSysopSecLevel THEN _
  1826.          ZAdjustedSecurity = (ZWasA <> ZUserSecLevel) : _
  1827.          IF ZAdjustedSecurity THEN _
  1828.             ZUserSecLevel = ZWasA : _
  1829.             MID$(ZUserRecord$,47,2) = MKI$(ZWasA) : _
  1830.             CALL QuickTPut1 ("Security changed to" + STR$(ZWasA)) : _
  1831.             CALL UpdtCalr ("Door reset security to "+STR$(ZWasA),2)
  1832.       GOTO 63105
  1833. 63115 IF LEN(ZOutTxt$(1)) < 7 THEN _
  1834.          GOTO 63105
  1835.       IF MID$(ZOutTxt$(1),3,1) <> "(" THEN _
  1836.          GOTO 63105
  1837.       WasX = INSTR(4,ZOutTxt$(1),":")
  1838.       IF WasX < 1 THEN _
  1839.          GOTO 63105
  1840.       CALL CheckInt (MID$(ZOutTxt$(1),4,WasX-4))
  1841.       IF ZErrCode > 0 THEN _
  1842.          GOTO 63105
  1843.       IF ZTestedIntValue > 128 OR ZTestedIntValue < 1 THEN _
  1844.          GOTO 63105
  1845.       ZWasA = ZTestedIntValue
  1846.       CALL CheckInt (MID$(ZOutTxt$(1),WasX+1))
  1847.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR ZTestedIntValue > 128 THEN _
  1848.          GOTO 63105
  1849.       MID$(ZUserRecord$,ZWasA,ZTestedIntValue) = LEFT$(ZOutTxt$(2) + _
  1850.          SPACE$(ZTestedIntValue),ZTestedIntValue)
  1851.       CALL UpdtCalr ("Door set UR"+STR$(ZWasA)+":"+STR$(ZTestedIntValue)+" to <"+ZOutTxt$(2)+">",2)
  1852.       GOTO 63105
  1853. 63195 CALL KillWork (ZFileName$)
  1854.       ZErrCode = 0
  1855.       END SUB
  1856. 63200 ' $SUBTITLE: 'WildCard -- Matches string to a pattern'
  1857. ' $PAGE
  1858. '  NAME    -- WildCard
  1859. '
  1860. '  INPUTS  -- PARAMETER             MEANING
  1861. '             Pattern$           PATTERN TO CHECK
  1862. '             Strng$             STRING TO FIE
  1863. '
  1864. '  OUTPUTS -- ZOK                True IF MATCH Found
  1865. '                                False IF No MATCH WAS Found
  1866. '
  1867. '  PURPOSE  Determine whether a string is an instance in a pattern
  1868. '           supported patterns are only "?" which requires a
  1869. '           character but can be any, and "*" which matches any-
  1870. '           thing, including a null string.  Anything else in a
  1871. '           sting must be an exact match.  Supports reverse
  1872. '           wildcards.
  1873. '
  1874. '
  1875.       SUB WildCard (Pattern$,Strng$) STATIC
  1876. 63285 ZOK = ZTrue
  1877.       PatPos = 0
  1878.       StrPos = 0
  1879.       Inc = 1
  1880.       WasKT = 0
  1881.       WasP = LEN(Pattern$)
  1882.       WasL = LEN(Strng$)
  1883. 63286 PatPos = PatPos + Inc
  1884.       StrPos = StrPos + Inc
  1885.       WasKT = WasKT + 1
  1886.       IF WasKT > WasL THEN _
  1887.          GOTO 63288
  1888.       ZUserIn$ = MID$(Pattern$,PatPos,1)
  1889.       IF ZUserIn$ = "*" THEN _
  1890.          GOTO 63289
  1891. 63287 IF ZUserIn$ <> "?" AND MID$(Strng$,StrPos,1) <> ZUserIn$ THEN _
  1892.          ZOK = ZFalse : _
  1893.          EXIT SUB
  1894.       GOTO 63286
  1895. 63288 IF PatPos >= LEN(Pattern$) OR PatPos < 1 THEN _
  1896.          EXIT SUB
  1897.       IF MID$(Pattern$,PatPos,1) <> "*" THEN _
  1898.          ZOK = ZFalse : _
  1899.          EXIT SUB
  1900. 63289 IF PatPos <> WasP THEN _   ' Reverse search
  1901.          Inc = -1 : _
  1902.          WasP = PatPos : _
  1903.          PatPos = LEN(Pattern$) + 1 : _
  1904.          StrPos = LEN(Strng$) + 1 : _
  1905.          WasKT = 0 : _
  1906.          GOTO 63286
  1907.       END SUB
  1908. 63300 ' $SUBTITLE: 'BreakFileName - sub to split file name into components'
  1909. ' $PAGE
  1910. '
  1911. '  NAME    -- BreakFileName
  1912. '
  1913. '  INPUTS  -- PARAMETER                    MEANING
  1914. '             FileSpec$        FULL NAME OF FILE
  1915. '             ForJoining       True IF WANT PARTS FORMATTED FOR
  1916. '                                           FORMING FILE NAMES
  1917. '  OUTPUTS -- DrvPath$         DRIVE AND PATH
  1918. '             Prefix$          PREFIX OF FILE NAME
  1919. '             Extension$       EXTENSION OF FILE NAME
  1920. '
  1921. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  1922. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  1923. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  1924. '
  1925. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  1926. '
  1927. '  PURPOSE -- To break a file name into its component parts
  1928. '             of drive/path, prefix, and extension
  1929. '
  1930. '
  1931.       SUB BreakFileName (FileSpec$,DrvPath$,Prefix$,Extension$,ForJoining) STATIC
  1932.       CALL AllCaps (FileSpec$)
  1933.       DrvPath$ = ""
  1934.       Prefix$ = ""
  1935.       Extension$ = ""
  1936.       CALL TrimTrail (FileSpec$,"\")
  1937.       WasL = LEN(FileSpec$)
  1938.       IF WasL < 1 THEN _
  1939.          EXIT SUB
  1940.       CALL FindLast (FileSpec$,"\",WasX,WasY)
  1941.       IF WasX < 1 THEN _
  1942.          IF MID$(FileSpec$,2,1) = ":" THEN _
  1943.             DrvPath$ = LEFT$(FileSpec$,1) : _
  1944.             ZWasS = 3 _
  1945.          ELSE ZWasS = 1 _
  1946.       ELSE DrvPath$ = LEFT$(FileSpec$,WasX-1) : _
  1947.            ZWasS = WasX + 1 : _
  1948.            IF WasY = 1 THEN _
  1949.               DrvPath$ = DrvPath$ + "\"
  1950.       WasX = INSTR(FileSpec$ + ".",".")
  1951.       IF WasX < WasL THEN _
  1952.          Extension$ = MID$(FileSpec$,WasX + 1)
  1953.       IF ZWasS <= WasL THEN _
  1954.          IF WasX >= ZWasS THEN _
  1955.             Prefix$ = MID$(FileSpec$,ZWasS,WasX - ZWasS)
  1956.       IF NOT ForJoining THEN _
  1957.          EXIT SUB
  1958.       IF LEN(DrvPath$) = 1 THEN _
  1959.          IF DrvPath$ <> "\" THEN _
  1960.             DrvPath$ = DrvPath$ + _
  1961.                        ":"
  1962.       IF INSTR(DrvPath$,"\") > 0 AND RIGHT$(DrvPath$,1) <> "\" THEN _
  1963.          DrvPath$ = DrvPath$ + _
  1964.                     "\"
  1965.       IF LEN(Extension$) > 0 THEN _
  1966.          Extension$ = "." + _
  1967.                       Extension$
  1968.       END SUB
  1969. 63310 ' $SUBTITLE: 'RestoreCom - sub to restore comm port'
  1970. ' $PAGE
  1971. '
  1972. '  NAME    -- RestoreCom
  1973. '
  1974. '  INPUTS  -- none
  1975. '
  1976. '  OUTPUTS -- none
  1977. '
  1978. '  PURPOSE -- To restore communications port after an external
  1979. '             program may have left it in altered state
  1980. '
  1981.       SUB RestoreCom STATIC
  1982.       Parity$ = MID$(",N,8,1,E,7,1",7 + 6 * ZEightBit,6)
  1983.       IF ZLocalUser THEN _
  1984.          EXIT SUB
  1985.       CALL SetBaud
  1986.       IF NOT ZFossil THEN _
  1987.          CALL OpenCom(ZTalkToModemAt$,Parity$)
  1988.       END SUB
  1989. 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS'
  1990. ' $PAGE
  1991. '
  1992. '  NAME    -- ShellExit
  1993. '
  1994. '  INPUTS  -- ShellTem$     String to invoke shell with
  1995. '
  1996. '  OUTPUTS -- none
  1997. '
  1998. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  1999. '             port on return
  2000. '
  2001.       SUB ShellExit (ShellTem$) STATIC
  2002.       CALL DelayTime (8 + ZBPS)
  2003.       IF NOT ZLocalUser THEN _
  2004.          IF ZFossil THEN _
  2005.             CALL FOSExit(ZComPort) _
  2006.          ELSE CLOSE 3 : _
  2007.               OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  2008.       CLOSE 2
  2009.       CALL MetaGSR (ShellTem$,ZFalse)
  2010.       SHELL ShellTem$
  2011.       IF ZFossil THEN _
  2012.          IF NOT ZLocalUser THEN _
  2013.             CALL FOSinit(ZComPort,Result) : _
  2014.             IF Result = -1 THEN _
  2015.                CALL PScrn("ERROR INITIALIZING FOSSIL AFTER EXTERNAL Protocol") : _
  2016.                SYSTEM
  2017.       CALL DelayTime (2)
  2018.       CALL RestoreCom
  2019.       END SUB
  2020. 63330 ' $SUBTITLE: 'ReadMacro - sub to read macro'
  2021. ' $PAGE
  2022. '
  2023. '  NAME    -- ReadMacro
  2024. '
  2025. '  INPUTS  -- PARAMETER             MEANING
  2026. '
  2027. '  OUTPUTS -- ZOutTxt$               LINE TO PROCESS IN MACRO
  2028. '             ZMacroActive           FLAG WHETHER IN A MACRO
  2029. '
  2030. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  2031. '             macro commands, which are:
  2032. '             *0 - display what follows, no carriage return
  2033. '             *1 - display what follows with carriage return
  2034. '             *B - display block that follows
  2035. '             *F - display File
  2036. '             WT - wait specified # of seconds
  2037. '             >> - append following block to specified file
  2038. '             ST - stack following (with carriage return)
  2039. '             ON - define case
  2040. '             == - case value that applies to following block
  2041. '             M! - execute following macro
  2042. '             M@ - abort macro processing
  2043. '             EY - Echo on (yes)
  2044. '             EN - Echo off (no)
  2045. '             /* - comment line skipped in processing
  2046. '             TK - Turbo key on (if user preference)
  2047. '             << - Read from file into a form
  2048. '             := - Assign value to work variable
  2049. '
  2050.       SUB ReadMacro STATIC
  2051.       IF ZMacroTemplate$ <> "" THEN _
  2052.          GOTO 63392
  2053.       IF ZDistantTGet = 2 THEN _
  2054.          GOTO 63349
  2055. 63336 GOSUB 63395
  2056.       IF NOT ZMacroActive THEN _
  2057.          ZMacroEcho = ZTrue : _
  2058.          EXIT SUB
  2059.       IF LEN(ZOutTxt$) < 3 THEN _
  2060.          GOTO 63398
  2061.       WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3)
  2062.       IF CompareVar > 0 THEN _
  2063.          IF NOT CaseExecute THEN _
  2064.             IF LEFT$(ZOutTxt$,3) = ZSmartTextCode$+"==" THEN _
  2065.                GOTO 63370 _
  2066.             ELSE IF LEFT$(ZOutTxt$,7) = ZSmartTextCode$ + "END ON" THEN _
  2067.                     CompareVar = 0 : _
  2068.                     GOTO 63336 _
  2069.                   ELSE GOTO 63336
  2070.       IF LEFT$(ZOutTxt$,1) <> ZSmartTextCode$ THEN _
  2071.          GOTO 63398
  2072.       CALL CheckInt (MID$(ZOutTxt$,2))
  2073.       IF ZErrCode > 0 THEN _
  2074.          GOTO 63398
  2075.       IF ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2076.          ZOutTxt$ = WasX$ : _  ' Macro command ask
  2077.          ZForceKeyboard = ZTrue : _
  2078.          ZMacroSave = ZTestedIntValue : _
  2079.          ZLinesPrinted = 1 : _
  2080.          ZNonStop = (ZPageLength < 1) : _
  2081.          EXIT SUB
  2082.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<:=LVNVCV",MID$(ZOutTxt$,2,2)))\2 GOTO _
  2083.          63345, _  ' Display with no Carriage Return
  2084.          63347, _  ' Display with Carriage Return
  2085.          63340, _  ' Display Block
  2086.          63348, _  ' Display File
  2087.          63343, _  ' Wait # of seconds
  2088.          63350, _  ' Append to file
  2089.          63355, _  ' Stack
  2090.          63360, _  ' Case
  2091.          63370, _  ' Case Comparison
  2092.          63375, _  ' Macro execute
  2093.          63380, _  ' Macro Abort
  2094.          63383, _  ' Macro Echo on
  2095.          63385, _  ' Macro Echo off
  2096.          63336, _  ' Macro Comment
  2097.          63387, _  ' Turbo Key allowed
  2098.          63390, _  ' Form read
  2099.          63362, _  ' Assign value to work var
  2100.          63363, _  ' LV list verify
  2101.          63364, _  ' NV number verify
  2102.          63364     ' CV character verify
  2103.       GOTO 63398
  2104. 63338 ZOutTxt$ = WasX$
  2105. 63339 ZSubParm = 4
  2106.       CALL TPut
  2107.       RETURN
  2108. 63340 WasX$ = ZSmartTextCode$ + "END"  ' Print Block
  2109.       GOSUB 63395
  2110.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2111.          GOSUB 63339
  2112.          CALL SkipLine (1)
  2113.          GOSUB 63395
  2114.       WEND
  2115.       GOTO 63336
  2116. 63343 CALL CheckInt (WasX$)      ' Delay
  2117.       IF ZErrCode = 0 THEN _
  2118.          CALL DelayTime (ZTestedIntValue)
  2119.       GOTO 63336
  2120. 63345 GOSUB 63338               ' Print Line
  2121.       GOTO 63336
  2122. 63347 GOSUB 63338
  2123.       CALL SkipLine (1)
  2124.       GOTO 63336
  2125. 63348 CALL Trim (WasX$)            ' Print File
  2126.       CALL FINDITX (WasX$,7)
  2127.       IF NOT ZOK THEN _
  2128.          GOTO 63336
  2129.       ZLinesPrinted = 1
  2130.       ZNo = ZFalse
  2131.       ZNonStop = (ZNonStop OR ZPageLength < 1)
  2132. 63349 WHILE (NOT EOF(7) AND (NOT ZNo) AND (ZNonStop OR (ZLinesPrinted < ZPageLength)) AND (ZSubParm > -1))
  2133.          CALL ReadDir (7,1)
  2134.          GOSUB 63396
  2135.          ZSubParm = 5
  2136.          CALL TPut
  2137.       WEND
  2138.       ZDistantTGet = 0
  2139.       IF ZSubParm < 0 THEN _
  2140.          EXIT SUB
  2141.       IF EOF(7) OR ZNo THEN _
  2142.          CLOSE 7 : _
  2143.          ZNo = ZFalse : _
  2144.          GOTO 63336
  2145.       ZDistantTGet = 2
  2146.       CALL PauseExit
  2147.       EXIT SUB
  2148. 63350 ZWasEN$ = WasX$            ' Append to file
  2149.       WasX = INSTR(ZWasEN$," /FL")
  2150.       OverStrike = (WasX > 0)
  2151.       IF OverStrike THEN _
  2152.          ZWasEN$ = LEFT$(ZWasEN$,WasX-1) + RIGHT$(ZWasEN$,LEN(ZWasEN$)-WasX-3)
  2153.       CALL Trim (ZWasEN$)
  2154.       CALL LockAppend
  2155.       IF ZErrCode > 0 THEN _
  2156.          GOTO 63352
  2157.       GOSUB 63395
  2158.       WasX$ = ZSmartTextCode$ + "END"
  2159.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2160.          CALL PrintWorkA (ZOutTxt$)
  2161.          GOSUB 63395
  2162.       WEND
  2163. 63352 CALL UnLockAppend
  2164.       OverStrike = ZFalse
  2165.       GOTO 63336
  2166. 63355 ZCommPortStack$ = ZCommPortStack$ + WasX$ + ZCarriageReturn$  ' STack
  2167.       GOTO 63336
  2168. 63360 CompareVar = VAL(WasX$)
  2169.       CALL AllCaps (WasX$)
  2170.       IF CompareVar < 1 OR CompareVar > ZMaxWorkVar THEN _
  2171.          CompareVar = 0
  2172.       GOTO 63336
  2173. 63362 CALL CheckInt (WasX$)
  2174.       WasX = INSTR(WasX$," ")
  2175.       IF WasX > 0 AND ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2176.       ZGSRAra$(ZTestedIntValue) = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2177.       GOTO 63336
  2178. 63363 ZVerifyList$ = WasX$
  2179.       CALL Trim (ZVerifyList$)
  2180.       GOTO 63365
  2181. 63364 CALL Trim (WasX$)
  2182.       WasX = INSTR(WasX$," ")
  2183.       IF WasX = 0 THEN _
  2184.          GOTO 63336
  2185.       ZVerifyLow$ = LEFT$(WasX$,WasX-1)
  2186.       ZVerifyHigh$ = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2187.       CALL Trim (ZVerifyLow$)
  2188.       CALL Trim (ZVerifyHigh$)
  2189.       ZVerifyNumeric = (MID$(ZOutTxt$,2,1) = "N")
  2190. 63365 ZVerifying = ZTrue
  2191.       GOTO 63336
  2192. 63370 IF CompareVar = 0 THEN _     ' Compare Case
  2193.          GOTO 63336
  2194.       ZWasDF$ = ZGSRAra$(CompareVar)
  2195.       CALL AllCaps (ZWasDF$)
  2196.       CaseExecute = (WasX$ = ZWasDF$)
  2197.       GOTO 63336
  2198. 63375 CALL Trim (WasX$)           ' Execute Macro
  2199.       CALL Macro (WasX$,WasX)
  2200.       GOTO 63336
  2201. 63380 ZMacroActive = ZFalse     ' Abort Macro
  2202.       GOTO 63398
  2203. 63383 ZMacroEcho = ZTrue
  2204.       GOTO 63336
  2205. 63385 ZMacroEcho = ZFalse
  2206.       GOTO 63336
  2207. 63387 ZTurboKey = -ZTurboKeyUser   'TK Turbo Key
  2208.       GOTO 63336
  2209. 63390 ZUserIn$ = ZOutTxt$
  2210.       ZUserIn$(5) = ""
  2211.       ZUserIn$(6) = ""
  2212.       ZWasQ = 1
  2213.       ZStoreParseAt = 1
  2214.       CALL ParseIt
  2215.       IF ZWasQ < 4 THEN _
  2216.          GOTO 63336
  2217.       WasX$ = ZSmartTextCode$ + "END"
  2218.       GOSUB 63397
  2219.       ZMacroTemplate$ = ""
  2220.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2221.          ZMacroTemplate$ = ZMacroTemplate$ + ZOutTxt$ + ZCrLf$
  2222.          GOSUB 63397
  2223.       WEND
  2224.       WasX = VAL(ZUserIn$(4))
  2225.       VarLen = (ZUserIn$(3) <> "/F")
  2226.       CALL FindIt (ZUserIn$(2))
  2227.       IF (WasX < 1) OR (NOT ZOK) OR (VarLen AND WasX > ZMaxWorkVar) THEN _
  2228.          ZMacroTemplate$ = "" : _
  2229.          GOTO 63336
  2230.       PauseEachRec = (ZUserIn$(6) = "/1")
  2231. 63392 CALL FormRead (ZMacroTemplate$,ZUserIn$(2),NOT VarLen,WasX,(ZUserIn$(5) = "/FL"),PauseEachRec)
  2232.       IF ZMacroTemplate$ <> "" THEN _
  2233.          EXIT SUB _
  2234.       ELSE GOTO 63336
  2235. 63395 GOSUB 63397
  2236.       GOSUB 63396
  2237.       RETURN
  2238. 63396 CALL SmartText (ZOutTxt$,ZFalse, OverStrike)
  2239.       CALL MetaGSR (ZOutTxt$,OverStrike)
  2240.       RETURN
  2241. 63397 IF EOF(6) THEN _         ' Read next line in macro
  2242.          ZMacroActive = ZFalse _
  2243.       ELSE CALL ReadDir (6,1) : _
  2244.            ZMacroActive = (ZErrCode = 0)
  2245.       RETURN
  2246. 63398 END SUB    ' Not Macro command - pass to normal processing
  2247. 63400 ' $SUBTITLE: 'LockAppend - prepares for file append'
  2248. ' $PAGE
  2249. '
  2250. '  NAME    -- LockAppend
  2251. '
  2252. '  INPUTS  -- ZWasEN$            Name of file to append to
  2253. '
  2254. '  OUTPUTS -- none
  2255. '
  2256. '  PURPOSE -- Locks and opens file to append to
  2257. '
  2258.       SUB LockAppend STATIC
  2259.       WasBX = &H4
  2260.       ZSubParm = 9
  2261.       CALL FileLock
  2262.       ZErrCode = 0
  2263.       CALL OpenWorkA (ZWasEN$)
  2264.       END SUB
  2265. 63410 ' $SUBTITLE: 'UnLockAppend - cleans up after file append'
  2266. ' $PAGE
  2267. '
  2268. '  NAME    -- UnLockAppend
  2269. '
  2270. '  INPUTS  -- none
  2271. '
  2272. '  OUTPUTS -- none
  2273. '
  2274. '  PURPOSE -- Unlocks and close file appending to
  2275. '
  2276.       SUB UnLockAppend STATIC
  2277.       WasBX = &H4
  2278.       ZSubParm = 10
  2279.       CALL FileLock
  2280.       CLOSE 2
  2281.       END SUB
  2282. 63420 ' $SUBTITLE: 'FormRead - Reads from a file into a form'
  2283. ' $PAGE
  2284. '
  2285. '  NAME    -- FormRead
  2286. '
  2287. '  INPUTS  -- Template$      Display formvoke shell with
  2288. '             FilName$       Data file to get values from
  2289. '             FixedLength    Whether file is fixed length
  2290. '             DataVar       # bytes data if fixed length; # fields
  2291. '                              if variable length
  2292. '             OverStrike     Whether typeover into form or insert
  2293. '             RecPause      Whether pause after every record displayed
  2294. '                               otherwise when screen fills
  2295. '  OUTPUTS -- (displays data base records)
  2296. '
  2297. '  PURPOSE -- Allows field oriented data base data to be displayed
  2298. '               in a human readable format by substituting field
  2299. '               data into template or form
  2300. '
  2301.       SUB FormRead (Template$,FilName$,FixedLength,DataVar,OverStrike,RecPause) STATIC
  2302. 63422 IF EOF(2) OR ZNo OR (ZErrCode > 0) OR (ZSubParm < 0) THEN _
  2303.          Template$ = "" : _
  2304.          EXIT SUB
  2305.       IF FixedLength THEN _
  2306.          CALL ReadDir (2,1) : _
  2307.          ZGSRAra$(1) = ZOutTxt$ _
  2308.       ELSE CALL ReadParms (ZGSRAra$(),DataVar,1)
  2309.       WasX$ = Template$
  2310.       CALL SmartText (WasX$,ZTrue,OverStrike)
  2311.       CALL MetaGSR (WasX$,OverStrike)
  2312.       CALL BufAsUnit (WasX$)
  2313.       IF RecPause OR (ZPageLength > 0 AND (ZLinesPrinted >= ZPageLength-1)) THEN _
  2314.          CALL PauseExit : _
  2315.          EXIT SUB
  2316.       GOTO 63422
  2317.       END SUB
  2318. 63440 ' $SUBTITLE: 'BufAsUnit - prints string with no pauses'
  2319. ' $PAGE
  2320. '
  2321. '  NAME    -- BufAsUnit
  2322. '
  2323. '  INPUTS  -- Strng$     String to print
  2324. '
  2325. '  OUTPUTS -- none
  2326. '
  2327. '  PURPOSE -- Prints string with embedded carriage returns.
  2328. '             Will never pause.  Used to print when can't call TGet
  2329. '
  2330.       SUB BufAsUnit (Strng$) STATIC
  2331.       WasL = LEN(Strng$)
  2332.       IF WasL < 1 THEN _
  2333.          EXIT SUB
  2334.       StartByte = 1
  2335. 63450 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  2336.       IF CRat > 0 AND CRat < WasL THEN _
  2337.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  2338.       ELSE CRFound = ZFalse
  2339.       EOLlen = -2 * CRFound
  2340.       IF CRFound THEN _
  2341.          EOD = CRat _
  2342.       ELSE EOD = WasL + 1
  2343.       NumBytes = EOD - StartByte
  2344.       ZOutTxt$ = MID$(Strng$,StartByte,NumBytes)
  2345.       ZSubParm = 4
  2346.       CALL TPut
  2347.       CALL SkipLine (-(CRFound))
  2348.       IF ZRet THEN _
  2349.          EXIT SUB
  2350.       StartByte = EOD + EOLlen
  2351.       IF StartByte <= WasL THEN _
  2352.          GOTO 63450
  2353.       END SUB
  2354. 63460 ' Check if macro exists and execute if does
  2355.       SUB MacroExe (Strng$) STATIC
  2356.       CALL Trim (Strng$)
  2357.       CALL Macro (Strng$,Found)
  2358.       IF NOT Found THEN _
  2359.          EXIT SUB
  2360.       CALL FdMacExe
  2361.       END SUB
  2362. 63462 ' Unconditionally executes a macro
  2363.       SUB FdMaCExe STATIC
  2364.       ZOutTxt$ = ""
  2365.       ZMacroEcho = ZFalse
  2366.       ZSubParm = 1
  2367.       CALL TGet
  2368.       END SUB
  2369. 63465 ' Forces a keyboard pause inside a macro
  2370.       SUB PauseExit STATIC
  2371.       ZSubParm = 4
  2372.       ZTurboKey = -ZTurboKeyUser
  2373.       ZOutTxt$ = ZMorePrompt$ + ">" + MID$("? ! ",2*ZTurboKey+1,2)
  2374.       ZForceKeyboard = ZTrue
  2375.       ZNoAdvance = ZTrue
  2376.       CALL TPut
  2377.       ZLinesPrinted = 0
  2378.       ZUserIn$ = ""
  2379.       END SUB
  2380. 63470 ' $SUBTITLE: 'SetPrompt - sub to set prompts based on user security'
  2381. ' $PAGE
  2382. '
  2383. '  NAME    -- SetPrompt
  2384. '
  2385. '  INPUTS  -- PARAMETER           MEANING
  2386. '             ZBegMain          POSITION START OF MAIN CMDS
  2387. '             ZBegFile          POSITION START OF FILE CMDS
  2388. '             ZBegUtil          POSITION START OF UTIL CMDS
  2389. '             ZBegLibrary       POSITION START OF Library CMDS
  2390. '
  2391. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2392. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2393. '             ZMainOpts$            MAIN OPTS USER CAN DO
  2394. '             ZFileOpts$            FILE OPTS USER CAN DO
  2395. '             ZUtilOpts$            UTIL OPTS USER CAN DO
  2396. '             ZLibOpts$         Library OPTS USER CAN DO
  2397. '
  2398. '  PURPOSE -- Sets command line display of what user can do by
  2399. '             section and display of what all user can do
  2400. '
  2401.       SUB SetPrompt STATIC
  2402.       First = ZBegMain
  2403.       Last = ZBegFile - 1
  2404.       CALL SetOpts (ZMainOpts$,ZInvalidMainOpts$,First,Last)
  2405.       First = ZBegFile
  2406.       Last = ZBegUtil - 1
  2407.       CALL SetOpts (ZFileOpts$,ZInvalidFileOpts$,First,Last)
  2408.       First = ZBegUtil
  2409.       Last = ZBegLibrary - 1
  2410.       CALL SetOpts (ZUtilOpts$,ZInvalidUtilOpts$,First,Last)
  2411.       First = ZBegLibrary
  2412.       Last = ZBegLibrary + 6
  2413.       CALL SetOpts (ZLibOpts$,ZInvalidLibraryOpts$,First,Last)
  2414.       First = 50
  2415.       Last = 56
  2416.       CALL SetOpts (SysOpt$,ZInvalidSysOpts$,First,Last)
  2417.       First = 46
  2418.       Last = 49
  2419.       CALL SetOpts (GlobalOpts$,InvalidGlobalOpts$,First,Last)
  2420.       IF LEN(SysOpt$) > 0 THEN _
  2421.          ZSystemOpts$ = "Sysop: " + _
  2422.                         SysOpt$
  2423.       ZMainOpts$ = GlobalOpts$ + _
  2424.                    ZMainOpts$
  2425.       ZFileOpts$ = GlobalOpts$ + _
  2426.                    ZFileOpts$
  2427.       ZUtilOpts$ = GlobalOpts$ + _
  2428.                    ZUtilOpts$
  2429.       ZLibOpts$ = GlobalOpts$ + _
  2430.                       ZLibOpts$
  2431.       CALL SortString (SysOpt$)
  2432.       CALL SortString (ZMainOpts$)
  2433.       ZMainOpts$ = ZMainOpts$ + _
  2434.                    SysOpt$
  2435.       CALL SortString (ZFileOpts$)
  2436.       CALL SortString (ZUtilOpts$)
  2437.       CALL SortString (ZLibOpts$)
  2438.       CALL AddCommas (ZMainOpts$)
  2439.       CALL AddCommas (ZFileOpts$)
  2440.       CALL AddCommas (ZUtilOpts$)
  2441.       CALL AddCommas (ZLibOpts$)
  2442.       ZDirPrompt$ = "What directory(s) (" + _
  2443.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (ZUserSecLevel => ZMinSecToView) + 9)
  2444.       ZQuitPromptExpert$ = "QUIT C,S, or to F,[M],U,@"
  2445.       ZQuitPromptNovice$ = "QUIT C)onference, S)ession or to section " + _
  2446.                             "F)ile, [M]ain, U)til or @)Library"
  2447.       ZQuitList$ = "FMUS@C"
  2448.       IF ZUserSecLevel < ZOptSec(18) THEN _
  2449.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,23) : _
  2450.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,61) : _
  2451.          MID$(ZQuitList$,5) = " "
  2452.       IF ZUserSecLevel < ZOptSec(15) THEN _
  2453.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,22) + _
  2454.                                MID$(ZQuitPromptExpert$,25) : _
  2455.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,56) + _
  2456.                                MID$(ZQuitPromptNovice$,63) : _
  2457.          MID$(ZQuitList$,3,1) = " "
  2458.       IF ZUserSecLevel < ZOptSec(6) THEN _
  2459.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,16) + _
  2460.                                MID$(ZQuitPromptExpert$,19) : _
  2461.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,41) + _
  2462.                                MID$(ZQuitPromptNovice$,49) : _
  2463.          MID$(ZQuitList$,1,1) = " "
  2464.       CALL SetSection
  2465.       END SUB
  2466. 63480 ' $SUBTITLE: 'NoPath - detects whether string has path'
  2467. ' $PAGE
  2468. '
  2469. '  NAME    -- NoPath
  2470. '
  2471. '  INPUTS  -- Strng$     String to check
  2472. '
  2473. '  OUTPUTS -- HAS.NONE   True if has no path
  2474. '
  2475. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2476. '             be any
  2477. '
  2478.       SUB NoPath (Strng$,HasPath) STATIC
  2479.       CALL BreakFileName (Strng$,DrvPath$,Prefix$,Ext$,ZFalse)
  2480.       HasPath = (DrvPath$ <> "")
  2481.       END SUB
  2482. 63490 ' $SUBTITLE: 'FindIt - Determine whether file exists'
  2483. ' $PAGE
  2484. '
  2485. '  NAME    -- FindIt
  2486. '
  2487. '  INPUTS  -- FilName$   File name to check
  2488. '
  2489. '  OUTPUTS -- ZOK         True if file exists.  Opened as #2 if does
  2490. '
  2491. '  PURPOSE -- Determine whether file exists and open as standard work
  2492. '             file if it does (#2)
  2493. '
  2494.       SUB FindIt (FilName$) STATIC
  2495.       CALL FindItX (FilName$,2)
  2496.       END SUB
  2497. 63495 ' $SUBTITLE: 'TimeBack - Give time back to the user'
  2498. ' $PAGE
  2499. '
  2500. '  NAME    -- TimeBack
  2501. '
  2502. '  INPUTS  -- Index    = 1    Set start of time (begin give back)
  2503. '                      = 2    Give back time from defined start
  2504. '
  2505. '  OUTPUTS -- ZTimeCredits!         Number of seconds to credit with
  2506. '             ZSecsPerSession!  Number of seconds in current session
  2507. '
  2508. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  2509. '
  2510.       SUB TimeBack (Index) STATIC
  2511.       IF Index = 1 THEN _
  2512.          CALL TimeRemain (MinsRemaining) : _
  2513.          ZWasQ! = ZSecsUsedSession! : _
  2514.          EXIT SUB
  2515.       CALL TimeRemain (MinsRemaining)
  2516.       WasX! = (ZSecsUsedSession! - ZWasQ!)
  2517.       ZTimeCredits! = ZTimeCredits! + WasX!
  2518.       END SUB
  2519. 63500 ' $SUBTITLE: 'CmdStackPushPop - Save/restore command stack'
  2520. ' $PAGE
  2521. '
  2522. '  NAME    -- CmdStackPushPop
  2523. '
  2524. '  INPUTS  -- Index    = 1    Save command stack
  2525. '                      = 2    Restore command stack
  2526. '             ZAnsIndex
  2527. '             ZLastIndex
  2528. '             ZUserIn$()
  2529. '
  2530. '  OUTPUTS -- ZUserIn$()                  Stacked commands
  2531. '             ZAnsIndex
  2532. '             ZLastIndex
  2533. '
  2534. '  PURPOSE -- Save restore a command stack list when need to input
  2535. '             another list in middle of previous list processing
  2536. '
  2537.       SUB CmdStackPushPop (Index) STATIC
  2538.       IF Index = 1 THEN _
  2539.          OrigLastIndex = ZLastIndex : _  ' save
  2540.          OrigIndex = ZAnsIndex : _
  2541.          FOR WasI = 1 TO OrigLastIndex : _
  2542.              ZOutTxt$(WasI) = ZUserIn$(WasI) : _
  2543.          NEXT : _
  2544.          EXIT SUB
  2545.       ZLastIndex = OrigLastIndex        ' restore
  2546.       ZAnsIndex = OrigIndex
  2547.       FOR WasI = 1 TO OrigLastIndex
  2548.          ZUserIn$(WasI) = ZOutTxt$(WasI)
  2549.       NEXT
  2550.       END SUB
  2551. 63510 ' $SUBTITLE: 'VerifyAns - edits an answer'
  2552. ' $PAGE
  2553. '
  2554. '  NAME    -- VerifyAns
  2555. '                                  MEANING
  2556. '  INPUTS  -- ZVerifying      Whether verifying
  2557. '             ZUserIn$(1)     Response verifying
  2558. '             ZVerifyList$    List of appropriate answers.  1st
  2559. '                                char is what separates answers
  2560. '             ZVerifyNumeric     Verify that is a valid integer
  2561. '                                  if false, then verifying that
  2562. '                                  a string is between 2 values
  2563. '             ZVerifyLow$     Lowest ok value of string
  2564. '             ZVerifyHigh$    Highest ok value of string
  2565. '
  2566. '  OUTPUTS -- ZOK             Whether passes verification
  2567. '             ZVerifyList$    Empties if ok
  2568. '             ZVerifying      Sets false if ok
  2569. '             ZVerifyNumeric  Sets false if ok
  2570. '
  2571. '  PURPOSE -- Processes edits on a user input
  2572. '
  2573.       SUB VerifyAns STATIC
  2574.       ZOK = ZTrue
  2575.       IF NOT ZVerifying THEN _
  2576.          EXIT SUB
  2577.       Temp$ = ZUserIn$(1)
  2578.       CALL AllCaps (Temp$)
  2579.       IF ZVerifyList$ <> "" THEN _
  2580.          WasX$ = LEFT$(ZVerifyList$,1) : _
  2581.          ZOK = (INSTR (ZVerifyList$, WasX$+Temp$+WasX$) > 0) _
  2582.       ELSE IF ZVerifyNumeric THEN _
  2583.               CALL CheckInt (ZUserIn$) : _
  2584.               ZOK = (ZErrCode = 0 AND _
  2585.                     ZTestedIntValue >= VAL(ZVerifyLow$) AND _
  2586.                     ZTestedIntValue <= VAL(ZVerifyHigh$)) _
  2587.            ELSE ZOK = (Temp$ >= ZVerifyLow$ AND Temp$ <= ZVerifyHigh$)
  2588.       IF ZOK THEN _
  2589.          ZVerifyList$ = "" : _
  2590.          ZVerifying = ZFalse : _
  2591.          ZVerifyNumeric = ZFalse
  2592.       END SUB
  2593. 63520 ' $SUBTITLE: 'BinSearch - binary search a file'
  2594. ' $PAGE
  2595. '
  2596. '  NAME    -- BinSearch
  2597. '                                  MEANING
  2598. '  INPUTS  -- PassedSearchFor$  Value you are looking for
  2599. '             StartPos          Starting position of sort key
  2600. '             NumChars          # of characters in sort key
  2601. '             LenRec            Length of record of data file searching
  2602. '             High              Record # of last record
  2603. '             ZFastTabs$        In a binary integer subfield (2 bytes)
  2604. '                                  holds 1st record when might find
  2605. '                                  a key beginning with a particular
  2606. '                                  character (0-9,A-Z).   Empty if
  2607. '                                  no Fast Tab exists for the file.
  2608. '
  2609. '  OUTPUTS -- RecFoundAt        Record # value found at (0 if none)
  2610. '             RecFound$         Full data record when found
  2611. '
  2612. '  PURPOSE -- Binary searches work file #2 for a key value in a
  2613. '             data file that is sorted on a key field
  2614. '
  2615.       SUB BinSearch (PassedSearchFor$,StartPos, NumChars, LenRec, High, RecFoundAt, RecFound$) STATIC
  2616.       SearchFor$ = LEFT$(PassedSearchFor$,NumChars)
  2617.       SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$))
  2618.       FIELD #2, LenRec AS SearchRec$
  2619.       Low = 0
  2620.       IF LEN(ZFastTabs$) < 72 THEN _
  2621.          GOTO 63522
  2622.       WasX$ = LEFT$(SearchFor$,1)
  2623.       WasX = INSTR("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",WasX$)
  2624.       IF WasX > 0 THEN _
  2625.          Low = CVI(MID$(ZFastTabs$,1+2*(WasX-1),2)) - 1
  2626.       IF WasX < 36 THEN _
  2627.          High = CVI(MID$(ZFastTabs$,1+2*WasX,2))
  2628. 63522 RecFoundAt = 0
  2629.       WasX$ = SPACE$ (NumChars)
  2630.       Done = ZFalse
  2631.       WHILE NOT Done
  2632.          WasI = INT(((High + Low) / 2) + .5)
  2633.          GET 2, WasI
  2634.          LSET WasX$ = MID$(SearchRec$, StartPos, NumChars)
  2635.          IF WasX$ = SearchFor$ THEN _
  2636.             RecFound$ = SearchRec$: _
  2637.             RecFoundAt = WasI : _
  2638.             Done = ZTrue _
  2639.          ELSE IF (High - Low) < 2 THEN _
  2640.                  Done = ZTrue _
  2641.               ELSE IF WasX$ < SearchFor$ THEN _
  2642.                       Low = WasI _
  2643.                    ELSE IF WasX$ > SearchFor$ THEN _
  2644.                            High = WasI
  2645.       WEND
  2646.       END SUB
  2647. 63530 ' Take modem offhook
  2648.       SUB TakeOffHook STATIC
  2649.       CALL ModemPut (ZModemGoOffHookCmd$)
  2650.       CALL DelayTime (3)
  2651.       END SUB
  2652. 63540 ' Match Name to one in message file
  2653.       SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC
  2654.       WasX$ = LEFT$(PrimeName$+"  ",22-8*(SearchPos < 7))
  2655.       Found = (MID$(ZMsgRec$,SearchPos, LEN(WasX$)) = WasX$)
  2656.       IF NOT Found THEN _
  2657.          IF AltName$ <> "" THEN _
  2658.             WasX$ = LEFT$(AltName$ + "  ",22-8*(SearchPos < 7)) : _
  2659.             Found = (MID$(ZMsgRec$,SearchPos, LEN(WasX$)) = WasX$)
  2660.       END SUB
  2661.