home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / rbbs / mpl17-2b.lzh / RBBSSUB5.BAS < prev    next >
BASIC Source File  |  1989-09-11  |  95KB  |  2,614 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 07-30-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  BRKFNAME   63300   Break file name into component parts
  19. '  BUFASUNIT  63500   Buffer out a string with CR's
  20. '  CALLOPT    63470   Set prompts based on the user's security
  21. '  DOORRTN    63100   Process door requests
  22. '  FILESYS    20117   File System for RBBS-PC
  23. '  FINDIT             Check whether file exists and if so open as #2
  24. '  FORMREAD   63420   Read from file into a form
  25. '  LOCKAPPND  63400   Prepare for a file append
  26. '  MACROEXE   63460   Execute internal macro rather than user
  27. '  NOPATH     63480   Detects whether string has a path in it
  28. '  RESTORECOM 63310   Restore comm port after external program
  29. '  READMACRO  63330   Read and process macro
  30. '  SHELLEXIT  63320   Exit RBBS via shell
  31. '  UNLKAPPND  63410   Clean up after file append
  32. '  WILDCARD   63200   Match string to a pattern
  33. '
  34. '  $INCLUDE: 'RBBS-VAR.BAS'
  35. '
  36. 20117 ' $SUBTITLE: 'FILESYS -- subroutine for RBBS-PC's file system'
  37. ' $PAGE
  38. '
  39. ' NAME    -- FILESYS
  40. '
  41. ' INPUTS  --       PARAMETER                 MEANING
  42. '             FILESYS.PARAMETER = 1  LIST THE SYSOP'S COMMENTS FILE
  43. '                                 2  L)IST DIRECTORY COMMAND
  44. '                                 3  D)OWNLOAD COMMAND
  45. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  46. '                                 5  U)PLOAD COMMAND
  47. '                                 6  S)CAN DIRECTORY COMMAND
  48. '                                 7  P)ERSONAL FILES COMMAND
  49. '                                 8  N)EW FILES COMMAND
  50. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  51. '
  52. ' OUTPUTS -- FILESYS.PARAMETER = 1  COMMAND PROCESSED SUCCESSFULLY
  53. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  54. '                                3  PROCESS NEXT COMMAND (1200)
  55. '                                4  DENY USER ACCESS (1380)
  56. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  57. '                                6  USER'S TIME EXCEEDED (10553)
  58. '                                7  CARRIER DROPPED (10595)
  59. '
  60. ' PURPOSE -- To handle the RBBS-PC file system commands
  61. '
  62.       SUB FILESYS STATIC
  63.       FF = FILESYS.PARAMETER
  64.       FILESYS.PARAMETER = 1
  65.       ON FF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  66.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  67.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  68.                   20262, _  ' RETURN FROM EXTERNAL PROTOCOL'S
  69.                   20400, _  ' U)PLOAD COMMAND HANDLER
  70.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  71.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  72.                   21860, _  ' N)EW FILES COMMAND HANDLER
  73.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  74.       GOTO 21920
  75. 20119 EC = 0
  76.       GOTO 20122
  77. '
  78. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  79. '
  80. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  81. 20120 A$ = CX$(2)+"Scanning"+CX$(3)+" Directory "+CX$(5) + _
  82.            FILE.NAME.HOLD$ +CX$(3)+ _
  83.            " for " +CX$(7)+ _
  84.            RS$
  85.       GOSUB 21650
  86.       IF FILESYS.PARAMETER > 1 THEN _
  87.          RETURN
  88.       PG = TRUE
  89. 20122 CALL OPENWORK (2,FILE.NAME$)
  90.       IF EC = 53 THEN _
  91.          CALL UPDTCALR ("Missing File " + FILE.NAME$,2) : _
  92.          A$ = "Missing file " + _
  93.               FILE.NAME$ + _
  94.               ". Please tell SYSOP" : _
  95.          GOSUB 21650 : _
  96.          RETURN
  97. 20124 CALL CARRIER
  98.       IF EOF(2) OR _
  99.          (SUBROUTINE.PARAMETER = -1 AND NOT LOCAL.USER) THEN _
  100.          GOTO 20142
  101. 20126 CALL READDIR (2,1)
  102.      IF EC <> 0 THEN _
  103.         EL = 20126 : _
  104.         GOTO 21900
  105.      IF CK = 0 THEN _
  106.         GOTO 20140
  107.      IF LEN(A$) > 0 THEN IF ASC(A$) = 32 THEN _
  108.         IF LAST.OK AND NOT EXTENDED.OFF THEN _
  109.            GOTO 20140 _
  110.         ELSE GOTO 20124
  111.      LAST.OK = FALSE
  112. 20128 IF CK > 1 THEN _
  113.          IF WILD.SEARCH THEN _
  114.             A = INSTR(A$," ") : _
  115.             IF A = 0 THEN _
  116.                GOTO 20124 _
  117.             ELSE Z$ = LEFT$(A$,A - 1) : _
  118.                  CALL WILDFILE (RS$,Z$,XXX) : _
  119.                  GOTO 20136_
  120.          ELSE Z$ = A$ : _
  121.               CALL ALLCAPS (Z$) : _
  122.               XXX = (INSTR(Z$,RS$) = 0) : _
  123.               GOTO 20136
  124. 20130 A = INSTR(9,MID$(A$,1,32),"/")
  125.       IF A = 0 THEN _
  126.          A = INSTR(9,MID$(A$,1,32),"-")
  127. 20132 IF A < 3 THEN _
  128.          GOTO 20124
  129.       IF INSTR("0123456789",MID$(A$,A - 1,1)) = 0 THEN _
  130.          GOTO 20124
  131.       A = A - 2
  132.       WK$ = RIGHT$(MID$(A$,A,8),2) + _
  133.             LEFT$(MID$(A$,A,8),2) + _
  134.             MID$(MID$(A$,A,8),4,2)
  135.       IF MID$(WK$,3,1) = " " THEN _
  136.          MID$(WK$,3,1) = "0"
  137.       IF MID$(WK$,5,1) = " " THEN _
  138.          MID$(WK$,5,1) = "0"
  139. 20134 XXX = (WK$ < RS$)
  140. 20136 IF XXX THEN _
  141.          GOTO 20124
  142.       IF PG THEN _
  143.          PG = FALSE : _
  144.          CALL OPENWORK (2,FILE.NAME$) : _
  145.          Q = 0 : _
  146.          GOTO 20124
  147. 20138 IF PG THEN _
  148.          GOTO 20124
  149. 20140 LAST.OK = TRUE
  150.       GOSUB 21650
  151.       IF FILESYS.PARAMETER > 1 THEN _
  152.          RETURN
  153.       CALL ASKMORE ("",TRUE,TRUE,ANS.INDEX,FALSE)                    ' KG081201
  154.       IF NO THEN _
  155.          EC = 0 : _
  156.          RETURN
  157.       IF NOT RET THEN _
  158.          GOTO 20124
  159. 20142 Q = 0
  160.       CLOSE 2
  161.       CALL CARRIER
  162.       IF SUBROUTINE.PARAMETER = -1 THEN _
  163.          FILESYS.PARAMETER = 7
  164.       RETURN
  165. '
  166. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  167. '
  168. 20150 LIST.DIRECTORY = TRUE
  169.       LIST.NEW = FALSE
  170.       SEARCH.DATE$ = ""
  171.       SEARCH.STRING$ = ""
  172.       SHOW.DIR.OF.DIR = NOT EXPERT.USER
  173.       CK = 0
  174.       IF Q > 1 THEN _
  175.          CALL ALLCAPS (B$(2)) : _
  176.          IF B$(2) = "L" THEN _
  177.             SHOW.DIR.OF.DIR = TRUE                                   ' KG081201
  178.       SEARCHING.ALL = FALSE                                          ' KG081201
  179. 20155 IF DOWNLOAD.COMPLETED AND AUTO.END = 1 THEN _
  180.         FILESYS.PARAMETER = 7: _
  181.         RETURN
  182.        IF LIST.NEW OR ANS.INDEX > 255 THEN _                          ' KG081201
  183.          RETURN                                                      ' KG081201
  184.       CALL GETDIRS (SHOW.DIR.OF.DIR)
  185.       IF Q = 0 THEN _
  186.          RETURN
  187.       SHOW.DIR.OF.DIR = FALSE
  188.       CALL CONVDIRS (ANS.INDEX)                                      ' KG081201
  189.       QX = LAST.INDEX                                                ' KG081201
  190. 20157 CALL CARRIER                                                   ' KG081201
  191.       IF SUBROUTINE.PARAMETER = -1 THEN _
  192.          FILESYS.PARAMETER = 7 : _
  193.          RETURN                                                      ' KG081201
  194.       GOTO 20161                                                     ' KG081201
  195. 20159 IF ANS.INDEX < LAST.INDEX THEN _                               ' KG081201
  196.          GOTO 20155                                                  ' KG081201
  197.       SEARCHING.ALL = FALSE                                          ' KG081201
  198.       CALL CSPUSHPOP (1)                                             ' KG082702
  199.       LAST.INDEX = 0                                                 ' KG082702
  200.       IF NO OR (FILE.NAME.HOLD$ = DIRECTORY.PREFIX$) THEN _
  201.          GOTO 20155                                                  ' KG081201
  202.       CALL QTPUT (EMPHASIZE.OFF$,0)
  203.       A$ = "End list.  R)elist, [Q]uit, or download what"
  204.       GOSUB 21668
  205.       CALL ALLCAPS (B$(1))
  206.       IF B$(1) = "R" THEN _
  207.          B$(ANS.INDEX) = A1$ : _                                     ' KG081201
  208.          GOTO 20161
  209.       IF LEN(B$(1)) > 1 AND _
  210.          USER.SECURITY.LEVEL >= OPT.SEC(19 - 20 * (MENU.INDEX = 6)) THEN _
  211.          ANS.INDEX = 1 : _                                           ' KG081201
  212.          GOSUB 20202                                                 ' KG082702
  213.       CALL CSPUSHPOP (2)                                             ' KG082702
  214.       RETURN                                                         ' KG082702
  215. 20161 IF INSTR(B$(ANS.INDEX),".") THEN _                             ' KG081201
  216.          GOTO 20172
  217.       VIOLATION$ = "List Dir. "
  218.       Z$ = B$(ANS.INDEX)                                             ' KG081201
  219.       A = INSTR("E+E-E",Z$)
  220.       IF A > 0 THEN _
  221.          IF A = 5 THEN _
  222.             EXTENDED.OFF = NOT EXTENDED.OFF : _
  223.             GOTO 20155 _                                             ' KG081201
  224.          ELSE EXTENDED.OFF = (A > 2) : _
  225.               GOTO 20155                                             ' KG081201
  226.       CALL ALLCAPS(Z$)
  227.       FILE.NAME.HOLD$ = Z$
  228.       A1$ = Z$
  229.       IF Z$ = DIRECTORY.PREFIX$ THEN _
  230.          GOTO 20164
  231.       IN.FMS = FALSE
  232. 20162 CALL CSPUSHPOP (1)         ' save dir list list processing     ' KG082702
  233.       CALL FMS (Z$,SEARCH.STRING$,SEARCH.DATE$,IN.FMS, _
  234.                 CATEGORY.NAME$(),CATEGORY.CODE$(),CATEGORY.DESC$(),_
  235.                 DOWNLOAD.FLAG,CAT.FOUND,ANS.INDEX)                   ' KG081201
  236.       WHILE DOWNLOAD.FLAG > 0 AND SUBROUTINE.PARAMETER > -1          ' KG081201
  237.          GOSUB 20202
  238.          IF FILESYS.PARAMETER > 1 THEN _
  239.             RETURN
  240.         IF DOWNLOAD.COMPLETED and AUTO.END = 1 THEN _
  241.            RETURN       ' AUTOLOGOFF MOD
  242.          X$ = CATEGORY.CODE$(CAT.FOUND)
  243.          CALL DISUPDIR (X$,SEARCH.STRING$,SEARCH.DATE$,DOWNLOAD.FLAG,ANS.INDEX) ' KG081201
  244.          CALL CHKTREMAIN (TIME.REMAINING!)
  245.          IF SUBROUTINE.PARAMETER = -1 THEN _
  246.             FILESYS.PARAMETER = 6 : _
  247.             RETURN
  248.          CALL CARRIER
  249.       WEND
  250.       IF SUBROUTINE.PARAMETER = -1 THEN _
  251.          FILESYS.PARAMETER = 7 : _
  252.          RETURN
  253.       IF ANS.INDEX > 255 THEN _                                      ' KG081201
  254.          LAST.INDEX = 0 : _                                          ' KG081201
  255.          RETURN                                                      ' KG081201
  256.       CALL CSPUSHPOP (2)        ' restore dir list list processing   ' KG082702
  257.       ACTIVE.FMS.DIRECTORY$ = ""
  258.       IF IN.FMS THEN _
  259.          GOTO 20159                                                  ' KG081201
  260.       IF USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW THEN _
  261.          IF FILE.NAME.HOLD$ = UPLOAD.DIR.CHECK$ THEN _
  262.             FILE.NAME.HOLD$ = "of uploads" : _
  263.             GOTO 20172
  264.       FILE.NAME.HOLD$ = B$(ANS.INDEX)                                ' KG081201
  265.       IF LIMIT.SEARCH.TO.FMS THEN _
  266.          GOTO 20166
  267.       IF NOT SEARCHING.ALL THEN _                                    ' KG081201
  268.          IF FILE.NAME.HOLD$ = "ALL" OR FILE.NAME.HOLD$ = "A" THEN _  ' KG081201
  269.             SEARCHING.ALL = TRUE : _                                 ' KG083002
  270.             GOTO 21890                                               ' KG081201
  271.       CALL BADFILE (FILE.NAME.HOLD$,BAD.FILE.NAME.INDEX)
  272.       ON BAD.FILE.NAME.INDEX GOTO 20163,20172,20176
  273. 20163 FILE.NAME$ = FILE.NAME.HOLD$
  274.       CALL BADNAME (BAD.FILE.NAME.INDEX)
  275.       ON BAD.FILE.NAME.INDEX GOTO 20164,20176
  276. 20164 IF FILE.NAME$ = UPLOAD.DIR.CHECK$ AND _
  277.          USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW THEN _
  278.             FILE.NAME$ = UPLOAD.PATH$ _
  279.       ELSE FILE.NAME$ = DIRECTORY.PATH$
  280.       FILE.NAME$ = FILE.NAME$ + _
  281.                    FILE.NAME.HOLD$ + _
  282.                    "." + _
  283.                    DIRECTORY.EXTENTION$
  284.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$,FILE.NAME$)
  285. 20165 IF OK THEN _
  286.          CALL READDIR (2,1) : _
  287.          IF EC = 0 THEN _
  288.             IF LEFT$(A$,4) = "\FMS" THEN _
  289.                IN.FMS = TRUE : _
  290.                ACTIVE.FMS.DIRECTORY$ = FILE.NAME$ : _
  291.                GOTO 20162 _
  292.             ELSE GOTO 20167
  293. 20166 FILE.NAME$ = DIRECTORY.PATH$ + _
  294.                    FILE.NAME.HOLD$ + ".MNU"
  295.       CALL FINDIT (FILE.NAME$)
  296.       IF OK THEN _
  297.          CALL BUFFILE (FILE.NAME$,ANS.INDEX) : _                     ' KG081201
  298.          GOTO 20155                                                  ' KG081201
  299.       IF ALTDIR.EXTENSION$ = "" THEN _
  300.          GOTO 20172
  301.       FILE.NAME$ = DIRECTORY.PATH$ + _
  302.                    FILE.NAME.HOLD$ + _
  303.                    "." + _
  304.                    ALTDIR.EXTENSION$
  305.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$,FILE.NAME$)
  306.       IF NOT OK THEN _
  307.          GOTO 20172
  308. 20167 B$(0) = B$(ANS.INDEX)                                          ' KG081201
  309.       IF NOT LIST.NEW THEN _
  310.          GOTO 20168
  311.       GOSUB 20120
  312.       IF FILESYS.PARAMETER > 1 THEN _
  313.          RETURN
  314.       GOTO 20170
  315. 20168 CALL BUFFILE(FILE.NAME$,ANS.INDEX)                             ' KG081201
  316.       CALL CARRIER
  317.       IF SUBROUTINE.PARAMETER = -1 THEN _
  318.          FILESYS.PARAMETER = 7 : _
  319.          RETURN
  320. 20170 IF ANS.INDEX > 255 THEN _                                      ' KG081201
  321.          LAST.INDEX = 0 : _                                          ' KG081201
  322.          RETURN                                                      ' KG081201
  323.       B$(ANS.INDEX) = B$(0)                                          ' KG081201
  324.       GOTO 20159                                                     ' KG081201
  325. 20172 IF NOT SEARCHING.ALL THEN _
  326.          A$ = "Directory " + _
  327.               FILE.NAME.HOLD$ + _
  328.               " not found!" : _
  329.          GOSUB 21640 : _
  330.          NO = TRUE : _
  331.          IF FILESYS.PARAMETER > 1 THEN _
  332.             RETURN
  333.       GOTO 20155                                                     ' KG081201
  334. 20176 CALL SVIOLATION
  335.       IF DENY.ACCESS THEN _
  336.          FILESYS.PARAMETER = 4 : _
  337.          RETURN
  338.       GOTO 20172
  339. '
  340. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  341. '
  342. 20180 A$ = CX$(5)+"Download"+CX$(6)+" what file(s)"+CX$(7)
  343.       GOSUB 21668                                                    ' KG081201
  344.       IF FILESYS.PARAMETER > 1 THEN _
  345.          RETURN
  346.       IF Q = 0 THEN _
  347.          RETURN
  348. 20202 IF (TIME.LOCK AND 2) AND (NOT TIME.LOCK.EXEMPT) AND NOT HAS.PRIVDOOR THEN _ ' KG052501
  349.          CALL TIMELOCK : _
  350.          IF NOT OK THEN _
  351.             RETURN
  352.       LAST.DOWNLOAD = LAST.INDEX                                     ' KG081201
  353.       FIRST.DOWNLOAD = ANS.INDEX                                     ' KG081201
  354.       COMMAND.TRANSFER$ = ""
  355.       IF AUTODOWNLOAD.AVAILABLE THEN _
  356.          COMMAND.TRANSFER$ = "X"
  357.       AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  358.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  359.          Z$ = B$(LAST.DOWNLOAD) : _
  360.          CALL ALLCAPS(Z$) : _
  361.          IF LEN (Z$) = 1 AND INSTR(DFLTXFER$,Z$) > 0 THEN _
  362.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  363.             COMMAND.TRANSFER$ = Z$ : _
  364.             AUTODOWNLOAD.IN.PROGRESS = FALSE : _
  365.             IF MID$(INTERNAL.EQUIV$,INSTR(DFLTXFER$,Z$),1) = "N" THEN _
  366.                COMMAND.TRANSFER$ = ""
  367.       BATCH.BYTES# = 0
  368.       BATCH.BLOCKS# = 0
  369.       CALL KILLWORK (NODE.WORK.FILE$)
  370.       EC = 0
  371.       FOR ANS.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD                ' KG081201
  372.          GOSUB 20205
  373.          COMMAND.TRANSFER$ = FT$                                     ' KG082301
  374.          CALL LINE25                                                 ' KG082703
  375.          IF FILESYS.PARAMETER > 1 THEN _
  376.             ANS.INDEX = LAST.DOWNLOAD + 1                            ' KG081201
  377. 20203 NEXT
  378.       LAST.INDEX = 0                                                 ' KG082702
  379.       IF FILESYS.PARAMETER > 1 THEN _
  380.          RETURN
  381.       BATCH.TRANSFER = FALSE
  382.       COMMAND.TRANSFER$ = ""
  383.       RETURN
  384. 20205 MARK.TIME = (ANS.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES)   ' KG081201
  385.       FILE.NAME$ = B$(ANS.INDEX)                                     ' KG081201
  386.       VIOLATION$ = "Download "
  387.       IF PERSONAL.DOWNLOAD THEN _
  388.          CALL BRKFNAME (FILE.NAME$,DR$,Y$,X$,TRUE) : _
  389.          FILE.NAME.HOLD$ = Y$ + _
  390.                            X$ : _
  391.          GOTO 20235
  392.       FILE.NAME.HOLD$ = FILE.NAME$
  393.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  394.       ON BAD.FILE.NAME.INDEX GOTO 20220,20231,20233
  395. 20220 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + _
  396.                       ((USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW) OR _
  397.                        NOT CAN.DOWNLOAD.FROM.UP),MARK.TIME)
  398. 20225 IF OK THEN _
  399.          GOTO 20235
  400. 20231 A$ = FILE.NAME.HOLD$ + _
  401.            " not found!"
  402.       CALL UPDTCALR (A$,2)
  403.       AUTO.LOGOFF = FALSE
  404.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  405.          A$ = A$ + _
  406.               " during AUTODOWNLOAD" : _
  407.          GOSUB 21640 : _
  408.          RETURN
  409.       A$ = A$ + _
  410.            " Correct name"+PRESS.ENTER.EXPERT$
  411.       GOSUB 21660
  412.       IF FILESYS.PARAMETER > 1 THEN _
  413.          RETURN
  414.       IF Q=0 THEN _
  415.          RETURN
  416.       B$(ANS.INDEX) = B$(1)                                          ' KG081201
  417.       GOTO 20205
  418. 20233 CALL SVIOLATION
  419.       IF DENY.ACCESS THEN _
  420.          FILESYS.PARAMETER = 4 : _
  421.          RETURN
  422.       GOTO 20231
  423. 20235 CALL BADNAME (BAD.FILE.NAME.INDEX)
  424.       ON BAD.FILE.NAME.INDEX GOTO  20236,20245
  425. 20236 LINE.25$ = "(D) " + _
  426.                  Z$
  427.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  428.          MID$(LINE.25$,2,1) = "A"
  429. '
  430. ' *  TEST FOR DOWNLOAD SECURITY
  431. '
  432.       CALL OPENWORK (2,FILESEC.FILE$)
  433.       IF EC = 53 THEN _
  434.          CALL UPDTCALR ("Missing file " + FILESEC.FILE$,2) : _
  435.          GOTO 20247
  436. 20242 IF EOF(2) THEN _
  437.          GOTO 20247
  438.       CALL READPARMS (WORK.ARA$(),3,1)
  439.       IF EC <> 0 THEN _
  440.          EL = 20242 : _
  441.          GOTO 21900
  442. 20243 CALL WILDFILE (WORK.ARA$(1),Z$,OK)
  443.       IF NOT OK THEN _
  444.          GOTO 20242
  445. 20244 IF USER.SECURITY.LEVEL < VAL(WORK.ARA$(2)) THEN _
  446.          GOTO 20245
  447.       FILE.PASSWORD$ = WORK.ARA$(3)
  448.       IF FILE.PASSWORD$ = "" THEN _
  449.          GOTO 20247
  450.       CALL ALLCAPS (FILE.PASSWORD$)
  451.       IF FILE.PASSWORD$ = PASSWORD$ THEN _
  452.          GOTO 20247
  453.       A$ = "Enter PASSWORD to download " + _
  454.            FILE.NAME$
  455.       GOSUB 21660
  456.       IF FILESYS.PARAMETER > 1 THEN _
  457.          RETURN
  458.       IF Q = 0 THEN _
  459.          RETURN
  460.       CALL ALLCAPS (B$(1))
  461.       IF B$(1) = FILE.PASSWORD$ THEN _
  462.          GOTO 20247
  463. 20245 VIOLATION$ = "DownLoad " + _
  464.                    FILE.NAME$
  465. 20246 CALL SVIOLATION
  466.       IF DENY.ACCESS THEN _
  467.          FILESYS.PARAMETER = 4
  468.       RETURN
  469. 20247 DF = 0
  470.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  471.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  472.          A$ = "Transferring -- " + _
  473.               B$(ANS.INDEX) : _                                      ' KG081201
  474.          GOSUB 21640 : _
  475.          IF FILESYS.PARAMETER > 1 THEN _
  476.             RETURN
  477.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+EXTENTION$+".") > 2 OR _ ' KG081601
  478.          MID$(EXTENTION$,2,1) = "Q" OR _
  479.          (REQUIRE.NON.ASCII AND EXTENTION$ = "BAS") THEN _
  480.             DF = TRUE                                                ' KG081201
  481. 20248 A$ = ""
  482.       IF BATCH.TRANSFER THEN _
  483.          IF ANS.INDEX < LAST.DOWNLOAD THEN _                         ' KG081201
  484.             GOTO 20260
  485.       CALL XFERTYPE (2,TRUE)
  486.       IF FF THEN _
  487.          GOTO 20260
  488.       CALL XFERTYPE (1,TRUE)
  489.       IF SUBROUTINE.PARAMETER = -1 THEN _
  490.          FILESYS.PARAMETER = 7 : _                                   ' KG081201
  491.          RETURN
  492. 20260 TRANSFER.FUNCTION = 1
  493.       GOSUB 21790
  494.       IF FILESYS.PARAMETER > 1 THEN _
  495.          RETURN
  496. BATCH.TRANSFER = BATCH.PROTO    'Pe Batch Mod
  497. '      BATCH.TRANSFER = (BATCH.PROTO AND (LAST.DOWNLOAD > FIRST.DOWNLOAD))
  498.       IF BATCH.TRANSFER AND COMMAND.TRANSFER$ = "" THEN _
  499.          COMMAND.TRANSFER$ = FT$
  500.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  501.          20340, _              ' ASCII DOWNLOAD
  502.          20290, _              ' XMODEM
  503.          20290, _              ' XMODEM CRC
  504.          20270, _              ' YMODEM
  505.          21700                 ' NONE - CANCEL
  506. '
  507. ' *  EXTERNAL PROTOCOL DOWNLOADS/UPLOADS
  508. '
  509. 20261 IF REQ.8.BIT THEN _
  510.          IF NOT EIGHT.BIT THEN _
  511.             GOSUB 20318 : _
  512.             IF FILESYS.PARAMETER > 1 THEN _
  513.                RETURN _
  514.             ELSE GOSUB 20992 : _
  515.                  IF FILESYS.PARAMETER > 1 THEN _
  516.                     RETURN
  517.       IF TRANSFER.FUNCTION = 1 THEN _
  518.          GOSUB 20750 : _
  519.          CLOSE 2 : _
  520.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  521.             RETURN
  522.       IF BATCH.TRANSFER THEN _
  523.          IF ANS.INDEX < LAST.DOWNLOAD THEN _                         ' KG081201
  524.             RETURN _
  525.          ELSE BLOCKS.IN.FILE# = BATCH.BLOCKS# : _
  526.               BYTES.IN.FILE# = BATCH.BYTES# : _
  527.               NUM.DNLD.BYTS! = BATCH.BYTES# : _
  528.               IF BYTES.IN.FILE# < 1 THEN _                           ' KG082507
  529.                  RETURN _                                            ' KG082507
  530.               ELSE GOSUB 20780 : _                                   ' KG082507
  531.                    IF FILESYS.PARAMETER > 1 OR NOT OK THEN _         ' KG082507
  532.                       RETURN                                         ' KG082507
  533.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  534.          CALL SENDNAME : _
  535.          IF ABORT THEN _
  536.             DOWNLOAD.COMPLETED = FALSE : _
  537.             GOSUB 21760 : _
  538.             RETURN
  539.       CALL TRANSFER
  540. 20262 IF PRIVATE.DOOR THEN _
  541.          COMMAND.TRANSFER$ = FT$ : _
  542.          CALL XFERTYPE (2,TRUE) : _
  543.          COMMAND.TRANSFER$ = ""
  544.       CALL OPENWORK (2,"XFER-" + NODE.ID$ + ".DEF")
  545.       IF EC <> 0 THEN _
  546.          GOTO 20267
  547.       CALL READPARMS (WORK.ARA$(), FAILURE.PARM, 1)
  548.       IF EC <> 0 THEN _
  549.          GOTO 20267
  550.       CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF")
  551. 20264 IF PRIVATE.DOOR THEN _
  552.          FILE.NAME$ = WORK.ARA$(1) : _
  553.          CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _
  554.          FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _
  555.                            Y$ : _
  556.          SIZE.ONLY = TRUE : _
  557.          CALL OPENWORK (2,FILE.NAME$) : _
  558.          GOSUB 20760 : _
  559.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  560.             RETURN
  561.          IF LEFT$(WORK.ARA$(FAILURE.PARM),1) = "L" THEN _
  562.             MID$(WORK.ARA$(FAILURE.PARM),1,1) = FAILURE.STRING$
  563. 20265 IF TRANSFER.FUNCTION = 2 THEN _
  564.          IF INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1 THEN _
  565.             GOTO 20700 _
  566.          ELSE GOTO 20730
  567.       IF TRANSFER.FUNCTION = 1 THEN _
  568.          DOWNLOAD.COMPLETED = (INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1)
  569.       GOSUB 21760
  570.       CALL CARRIER
  571.       IF SUBROUTINE.PARAMETER = -1 THEN _
  572.          FILESYS.PARAMETER = 7
  573.       RETURN
  574. '
  575. ' *  XFER FILE NOT FOUND
  576. '
  577. 20267 EL = 20262
  578.       GOTO 21900
  579.  
  580. '
  581. ' *  YMODEM DOWNLOAD DRIVER
  582. '
  583. 20270 GOTO 20292
  584. '
  585. ' *  XMODEM DOWNLOAD DRIVER
  586. '
  587. 20290 '
  588. 20292 GOSUB 20750
  589.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  590.          RETURN
  591.       A1$ = "SEND"
  592.       GOSUB 20320
  593.       IF FILESYS.PARAMETER > 1 THEN _
  594.          RETURN
  595.       IF LOCAL.USER THEN _
  596.          CALL QTPUT1 ("Protocol not available in local mode") : _
  597.          RETURN
  598.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  599.          GOSUB 20294 : _
  600.          IF ABORT THEN _
  601.             RETURN
  602.       GOSUB 21300
  603.       IF FILESYS.PARAMETER > 1 THEN _
  604.          RETURN
  605.       A$ = ""
  606.       GOTO 20390
  607. 20294 CALL SENDNAME
  608.       RETURN
  609. 20318 A$ = "Please SWITCH to N,8,1 for binary transfer"
  610.       GOSUB 21630
  611.       IF FILESYS.PARAMETER > 1 THEN _
  612.          RETURN
  613.       CALL DELAYIT (3)
  614.       RETURN
  615. 20320 IF NOT EIGHT.BIT THEN _
  616.          GOSUB 20318 : _
  617.          IF FILESYS.PARAMETER > 1 THEN _
  618.             RETURN
  619. 20325 IF CHECKSUM THEN _
  620.          NEGATIVE.ACKNOWLEDGE$ = CHR$(21) : _
  621.          SOL = 132 _
  622.       ELSE NEGATIVE.ACKNOWLEDGE$ = "C" : _
  623.            SOL = 133
  624. 20330 IF AUTODOWNLOAD.IN.PROGRESS THEN _
  625.          RETURN
  626.       A$ = PROTO.PROMPT$ + _
  627.             " " + A1$ + _
  628.             " of " + _
  629.             FILE.NAME.HOLD$ + _
  630.             " ready.  <Ctrl X> aborts"
  631.       GOSUB 21650
  632.       IF A1$ = "SEND" THEN _
  633.          CALL TALK (8,A$) _
  634.       ELSE CALL TALK (9,A$)
  635.       RETURN
  636. '
  637. ' *  ASCII DOWNLOAD DRIVER
  638. '
  639. 20340 IF DF THEN _
  640.          A$ = "Switch to a non-ascii protocol" : _
  641.          GOSUB 21650 : _
  642.          GOTO 21700
  643.       GOSUB 20750
  644.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  645.          RETURN
  646.       CALL OPENWORK (2,FILE.NAME$)
  647.       IF (ANS.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _     ' KG081201
  648.          A$ = "^X aborts.  ^S suspends ^Q resumes" : _
  649.          GOSUB 21640 : _
  650.          IF FILESYS.PARAMETER > 1 THEN _
  651.             RETURN _
  652.          ELSE A$ = PROTO.PROMPT$ + " SEND of " + _
  653.               FILE.NAME.HOLD$ + _
  654.               " ready. Press Any Key to start" : _
  655.          TURBO.KEY = 2 : _
  656.          FORCE.KEYBOARD = TRUE : _                                   ' KG090101
  657.          GOSUB 21660 : _
  658.          IF FILESYS.PARAMETER > 1 THEN _
  659.             RETURN
  660. 20380 STOP.INTERRUPTS = FALSE
  661.       TU = 0
  662.       SWAP TU,PAGE.LENGTH
  663.       CALL BUFFILE (FILE.NAME$,X)
  664.       SWAP TU,PAGE.LENGTH
  665.       NON.STOP = (PAGE.LENGTH < 1)
  666.       IF STOP.FILE THEN _
  667.          DOWNLOAD.COMPLETED = FALSE : _
  668.          GOTO 20390
  669. 20381 IF (ANS.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _      ' KG081201
  670.          CALL QTPUT (CHR$(26),0) : _
  671.          IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  672.             FOR X = 1 TO 5 : _
  673.                CALL PUTCOM (CHR$(7)) : _
  674.                CALL DELAYIT (3) : _
  675.             NEXT
  676. 20385 DOWNLOAD.COMPLETED = TRUE
  677. 20390 GOTO 21760
  678. '
  679. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  680. '
  681. 20395 GOSUB 21640
  682.       IF FILESYS.PARAMETER > 1 THEN _
  683.          RETURN
  684.       A$ = "Correct name of file to upload" + _
  685.            PRESS.ENTER.EXPERT$
  686.       GOSUB 21660
  687.       IF FILESYS.PARAMETER > 1 THEN _
  688.          RETURN
  689.       IF Q = 0 THEN _
  690.          RETURN
  691.       B$(ANS.INDEX) = B$(1)
  692.       GOTO 20435
  693. 20400 CALL TIMEBACK (1)                                              ' KG082701
  694.       GOSUB 20420                                                    ' KG081201
  695.       FIRST.UPLOAD = ANS.INDEX                                       ' KG081201
  696.       GOTO 20430
  697. 20420 A$ = "Upload what file(s)"                                     ' KG081201
  698.       GOSUB 21668                                                    ' KG081201
  699.       RETURN
  700. '
  701. ' *  SEARCH FOR DUPLICATE FILENAME
  702. '
  703. 20430 Z$ = B$(LAST.INDEX)                                            ' KG081201
  704.       IF LEN(Z$) = 1 THEN _
  705.          CALL ALLCAPS (Z$) : _
  706.          IF INSTR(DFLTXFER$,Z$) > 0 THEN _
  707.             LAST.INDEX = LAST.INDEX - 1 : _                          ' KG081201
  708.             COMMAND.TRANSFER$ = Z$
  709.       FOR ANS.INDEX = FIRST.UPLOAD TO LAST.INDEX                     ' KG081201
  710.          GOSUB 20435
  711.          IF FILESYS.PARAMETER > 1 THEN _
  712.             ANS.INDEX = LAST.INDEX + 1                               ' KG081201
  713.       NEXT
  714.       COMMAND.TRANSFER$ = ""
  715.       RETURN
  716. 20435 FILE.NAME.HOLD$ = B$(ANS.INDEX)
  717.       CALL ALLCAPS(FILE.NAME.HOLD$)
  718.       FILE.NAME$ = FILE.NAME.HOLD$
  719.       VIOLATION$ = "Upload "
  720. '      IF INSTR(FILE.NAME$,":") OR _
  721. '         INSTR(FILE.NAME$,"\") OR _
  722. '         INSTR(FILE.NAME$," ") OR _       'Pe 06/06/89
  723. '         INSTR(FILE.NAME$,"*") OR _  
  724. '         INSTR(FILE.NAME$,"?") OR _     'Pe 06/06/89
  725. '         INSTR(FILE.NAME$,"/") THEN _
  726. '         GOTO 20451
  727.       CALL NOPATH (FILE.NAME$,BAD.FILE.NAME.INDEX)                   ' KG060801
  728.       IF BAD.FILE.NAME.INDEX THEN _                                  ' KG060801
  729.          GOTO 20451                                                  ' KG060801
  730.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  731. 'comment out the NEXT 2 lines if you want to enable files without EXTENSION
  732. 'to regular users
  733. '
  734. IF EXT$ = "" AND USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  735.        GOTO 20451       'Pe 12/22/88
  736. '
  737.       ON BAD.FILE.NAME.INDEX GOTO 20440,20451,20515
  738. 20440 TMP.FILE.NAME$ ="NOTHANX.DEF"               'PE mode
  739.       CALL FINDIT (TMP.FILE.NAME$)                                'DGS-UNW
  740.       IF OK THEN                                                  'DGS-UNW
  741.        CALL QTPUT ("Checking off line file list....",1)           'Pe 02/11/89
  742.      OPEN TMP.FILE.NAME$ FOR INPUT AS #9                      'DGS-UNW
  743.      HAV.FILE$ = ""                                           'DGS-UNW
  744.      FILE.IN.LIST = FALSE                                     'DGS-UNW
  745.      WHILE NOT EOF(9) AND NOT FILE.IN.LIST                    'DGS-UNW
  746.         INPUT #9, HAV.FILE$                                   'DGS-UNW
  747.         CALL ALLCAPS (HAV.FILE$)                              'DGS-UNW
  748.         FILE.IN.LIST = (INSTR(FILE.NAME.HOLD$,HAV.FILE$) > 0) 'DGS-UNW
  749.      WEND                                                     'DGS-UNW
  750.      CLOSE 9                                                  'DGS-UNW
  751.       END IF                                                      'DGS-UNW
  752.       IF FILE.IN.LIST THEN _                                      'DGS-UNW
  753.       CALL BUFFILE ("NOTHANX.MSG",X) : _         'Pe 02/19/89
  754.      GOTO 20453                                               'DGS-UNW
  755.        CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)
  756. 20450 IF OK THEN _
  757.          GOTO 20452
  758.       CLOSE 2                                                        ' MC0220
  759.       OPEN "EXTCHECK.DEF" FOR INPUT AS #2                            ' MC0220
  760.       DO WHILE NOT EOF(2)                                            ' MC0220
  761.        INPUT #2, CHECK$                                          ' MC0220
  762.       IF INSTR(FILE.NAME$,".") AND _                                 ' MC0220
  763.      RIGHT$(FILE.NAME.HOLD$,3) <> CHECK$ THEN _                  ' MC0220
  764.      FILE.NAME$ = LEFT$(FILE.NAME.HOLD$,LEN(FILE.NAME.HOLD$)-3) + _
  765.      CHECK$ : _                                                  ' MC0220
  766.      CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)     ' MC0220
  767.       IF OK THEN _                                                   ' MC0220
  768.      GOTO 20452                                                  ' MC0220
  769.        LOOP                                                          ' MC0220
  770.        CLOSE 2                                                       ' MC0220
  771.       GOTO 20475
  772.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  773.       IF EXTENTION$ = DEFAULT.EXTENSION$ THEN _
  774.          GOTO 20475
  775.       X$ = X$ + "." + DEFAULT.EXTENSION$
  776.       CALL ROTORSDIR (X$,SUBDIR$(),SUBDIR.COUNT,FALSE)
  777.       IF OK THEN _
  778.          FILE.NAME.HOLD$ = DEFAULT.EXTENSION$ + " ver of " + FILE.NAME.HOLD$ : _
  779.          GOTO 20454
  780.       GOTO 20475
  781.  20451 A$ = "Invalid file name. File name cannot contain a Drive letter"+CRLF$ +_
  782.            "Subdirectory name, a Space, or any WildCard Characters "
  783.       GOSUB 21655
  784.       CALL DELAYIT (2)
  785.       FILESYS.PARAMETER = 3
  786.       RETURN
  787. 20452 IF USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  788.          GOTO 20453
  789.       A$ = "Overwrite file (Y,[N])"
  790.       GOSUB 21660
  791.       IF FILESYS.PARAMETER > 1 THEN _
  792.          RETURN
  793.       IF NOT YES THEN _
  794.          GOTO 20453
  795.       Z$ = FILE.NAME$
  796.       CALL KILLWORK (FILE.NAME$)
  797.       IF EC <> 0 THEN _
  798.          EL = 20452 : _
  799.          GOTO 21900
  800.       GOTO 20475
  801. 20453 CLOSE 2
  802.       IF USER.SECURITY.LEVEL >= ADD.DIR.SECURITY THEN _
  803.          GOTO 20455
  804. 20454 CALL QTPUT1 ("Thanks, but we already have " + FILE.NAME.HOLD$)
  805.       CALL UPDTCALR ("Upload duplicate " + FILE.NAME.HOLD$,1)
  806.       RETURN
  807. 20455 A$ = "Add new directory entry (Y,[N])"
  808.       TURBO.KEY = - TURBO.KEY.USER
  809.       GOSUB 21660
  810.       IF FILESYS.PARAMETER > 1 THEN _
  811.          RETURN
  812.       IF NOT YES THEN _
  813.          RETURN
  814.       ADDING.DESC.ONLY = TRUE
  815.       FT$ = "l"
  816. CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,1) 'UPL-MOD
  817.       GOSUB 20702
  818.       RETURN
  819. 20475 FILE.NAME$ = LEFT$(FILE.NAME$,LEN(FILE.NAME$)-3) + _           'MC0220
  820.       RIGHT$(FILE.NAME.HOLD$,3)                                      'MC0220
  821.       Z$ = UPLOAD.DRIVE.FILE$
  822.       CALL FINDFREE
  823.       IF VAL(FREE.SPACE$) < 4096 THEN _
  824.          CALL QTPUT1 ("No room for uploads.  Try tomorrow.") : _
  825.          ANS.INDEX = LAST.INDEX + 1 : _                              ' KG081201
  826.          RETURN
  827.       A$ = "Upload disk has" + _
  828.            FREE.SPACE$
  829.       GOSUB 21640
  830.       IF FILESYS.PARAMETER > 1 THEN _
  831.          RETURN
  832. '*****************
  833. CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,1)  '<++++++
  834. '*****************
  835. IF ABORT THEN _     'PE 12/14/88
  836. ABORT = FALSE : _   'PE 12/14/88
  837.  RETURN
  838.       LINE.25$ = "(U) " + _
  839.                  FILE.NAME.HOLD$
  840.       SUBROUTINE.PARAMETER = 2
  841.       CALL LINE25
  842.       A$ = ""
  843.       OK = TRUE
  844. 20477 CALL XFERTYPE (2,TRUE)
  845.       IF FF THEN _
  846.          GOTO 20500
  847.       CALL XFERTYPE (1,TRUE)
  848.       IF SUBROUTINE.PARAMETER = -1 THEN _
  849.          FILESYS.PARAMETER = 7 : _                                   ' KG081201
  850.          RETURN
  851. 20500 CALL AUTOLOGOFF       'Autologoff mod
  852.      TRANSFER.FUNCTION = 2
  853.       AUTODOWNLOAD.IN.PROGRESS = FALSE
  854.       GOSUB 21790
  855.       IF FILESYS.PARAMETER > 1 THEN _
  856.          RETURN
  857.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  858.          20560, _         ' ASCII UPLOAD
  859.          20542, _         ' XMODEM
  860.          20542, _         ' XMODEM CRC
  861.          20542, _         ' YMODEM
  862.          20735            ' NONE - CANCEL
  863.       GOTO 20261
  864. 20510 D$ = "<Esc> by SYSOP aborts"
  865.       GOSUB 21710
  866.       RETURN
  867. 20515 CALL SVIOLATION
  868.       IF DENY.ACCESS THEN _
  869.          FILESYS.PARAMETER = 4 : _
  870.          RETURN
  871.       GOTO 20420
  872. '
  873. ' *  XMODEM/YMODEM UPLOAD DRIVER
  874. '
  875. 20542 A1$ = "RECEIVE"
  876.       GOSUB 20320
  877.       IF FILESYS.PARAMETER > 1 THEN _
  878.          RETURN
  879.       OK = TRUE
  880.       GOSUB 20860
  881.       IF FILESYS.PARAMETER > 1 THEN _
  882.          RETURN
  883.       IF OK THEN _
  884.          GOTO 20700
  885.       GOTO 20730
  886. '
  887. ' *  ASCII UPLOAD
  888. '
  889. 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "")
  890.       IF LINE.ACK THEN _
  891.          A$ = "Acknowledge each line ([Y],N)" : _
  892.          TURBO.KEY = - TURBO.KEY.USER : _
  893.          LINE.ACK = NOT NO : _
  894.          GOSUB 21660 : _
  895.          IF FILESYS.PARAMETER > 1 THEN _
  896.             RETURN
  897.       CALL QTPUT1 ("Transfer MUST end with a <Ctrl-K>")
  898.       CALL QTPUT1 (PROTO.PROMPT$+" RECEIVE of " + FILE.NAME.HOLD$ + " ready")
  899.       OK = FALSE
  900.       XOFF = FALSE
  901.       CALL OPENOUTW(FILE.NAME$)
  902.       IF EC <> 0 AND EC <> 53 THEN _
  903.          EL = 20560 : _
  904.          GOTO 21900
  905.       GOSUB 20510
  906.       IF FILESYS.PARAMETER > 1 THEN _
  907.          RETURN
  908. 20600 CALL EOFCOMM (CHAR%)
  909.       WHILE CHAR% <> -1
  910.          CALL CARRIER
  911.          IF SUBROUTINE.PARAMETER = -1 THEN _
  912.             FILESYS.PARAMETER = 7 : _
  913.             RETURN
  914.          IF NOT FOSSIL THEN _
  915.             IF LOF(3) < 512 THEN _
  916.                CALL PUTCOM(XOFF$) : _
  917.                XOFF = TRUE
  918. 20610    CALL FLUSHCOM (X$)
  919.          IF SUBROUTINE.PARAMETER = -1 THEN _
  920.             FILESYS.PARAMETER = 7 : _                                   ' KG081201
  921.             RETURN
  922.          IF INSTR(X$,CHR$(11)) THEN _
  923.             GOTO 20650
  924.          OK = TRUE
  925. 20620    CALL PRINTWRK (X$)
  926.          IF LINE.ACK THEN _
  927.             IF INSTR(X$,CHR$(10)) > 0 THEN _
  928.                CALL PUTCOM (DEFAULT.LINE.ACK$)
  929.          IF EC <> 0 THEN _
  930.             EL = 20620 : _
  931.             GOTO 21900
  932.          D$ = X$
  933.          NUM.RETURNS = 0
  934.          GOSUB 21720
  935.          IF FILESYS.PARAMETER > 1 THEN _
  936.             RETURN
  937. 20621    CALL FINDFUNC
  938.          IF SUBROUTINE.PARAMETER < 0 THEN _
  939.             FILESYS.PARAMETER = 2 : _
  940.             RETURN
  941.          IF KEY.PRESSED$ = ESCAPE$ THEN _
  942.             GOTO 20745
  943.          IF NOT OK THEN _
  944.             GOTO 20670
  945.       CALL EOFCOMM (CHAR%)
  946. 20630 WEND
  947.       CALL CARRIER
  948.       IF SUBROUTINE.PARAMETER = -1 THEN _
  949.          FILESYS.PARAMETER = 7 : _
  950.          RETURN
  951.       IF XOFF THEN _
  952.          XOFF = FALSE : _
  953.          CALL PUTCOM (XON$) : _
  954.          IF EC <> 0 THEN _
  955.             EL = 20630 : _
  956.             GOTO 21900
  957.       GOTO 20600
  958. 20650 X = INSTR(X$,CHR$(11))
  959.       IF X = 1 THEN _
  960.          IF NOT OK THEN _
  961.             GOTO 20730 _
  962.          ELSE GOTO 20700
  963.       CALL PRNTWRKA (LEFT$(X$,X-1))
  964.       IF EC <> 0 THEN _
  965.          EL = 20650 : _
  966.          GOTO 21900
  967.       GOTO 20700
  968. 20670 A$ = XOFF$ + _
  969.            "System error! Upload aborted <Ctrl-K> continues"
  970. 20675 GOSUB 21650
  971.       IF FILESYS.PARAMETER > 1 THEN _
  972.          RETURN
  973.       CALL DELAYIT (3)
  974.       CALL PUTCOM(XON$)
  975. 20680 CALL EOFCOMM (CHAR%)
  976.       WHILE CHAR% <> -1
  977.          CALL FLUSHCOM(X$)
  978.          IF INSTR(X$,CHR$(11)) THEN _
  979.             GOTO 20730
  980. 20685    CALL CARRIER
  981.          IF SUBROUTINE.PARAMETER = -1 THEN _
  982.             FILESYS.PARAMETER = 7 : _
  983.             RETURN
  984.       CALL EOFCOMM (CHAR%)
  985.       WEND
  986.       GOTO 20680
  987. '
  988. ' *  UPDATE UPLOAD DIRECTORY
  989. '
  990. 20700 GOSUB 21780
  991.       IF FILESYS.PARAMETER > 1 THEN _
  992.          RETURN
  993. 20702 CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,2)  '<++++++
  994. '***** AUTO UP MOD *****
  995.  IF AUTO.END = 1 THEN _                   'AUTO-UP MOD to next comment
  996. CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE): _
  997. Z$ = X$+EXTENTION$+DF$+" at "+TIM$ +" using " + FT$ + STR$(BYTES.IN.FILE#) :_
  998.       CALL UPDTCALR (Z$,2) : _
  999.      RETURN                             'AUTO-UP MOD
  1000. '***** end of Auto Up Mod****
  1001.       PRIVATE.DOOR = FALSE
  1002.       IF NOT GET.EXT.DESC THEN _
  1003.          GOTO 20710
  1004.       MSG.HEADER$ = "Extended Description for " + FILE.NAME.HOLD$    ' KG072003
  1005.       SYSOP.COMMENT = TRUE
  1006.       MAX.MESSAGE.LINES = MAX.EXTENDED.LINES
  1007.       LL = RIGHT.MARGIN
  1008.       RIGHT.MARGIN = 30 + MAX.DESC.LEN
  1009.       FILESYS.PARAMETER = 5
  1010.       RETURN
  1011. 20705 MAX.MESSAGE.LINES = MAX.MESSAGE.LINES.DEF
  1012.       RIGHT.MARGIN = LL
  1013.              CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(),LINES.IN.MESSAGE,3)  '<++++++
  1014. 20710 ADDING.DESC.ONLY = FALSE
  1015.       IF BYTES.IN.FILE# > 0.0 THEN _
  1016.          GOTO 21770
  1017. 20730 GOSUB 21780
  1018.       CALL QTPUT1 ("Upload aborted")
  1019.       PRIVATE.DOOR = FALSE
  1020. 20735 CALL KILLWORK (FILE.NAME$)
  1021.       IF EC <>0 THEN _
  1022.          EL = 20736 : _
  1023.          GOTO 21900
  1024.       RETURN
  1025. '
  1026. ' *  SYSOP ABORTED UPLOAD
  1027. '
  1028. 20745 A$ = XOFF$ + _
  1029.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  1030.       GOTO 20675
  1031. '
  1032. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  1033. '
  1034. 20750 START.OF.HEADER$ = CHR$(1 - (INTERNAL.PROTO$ = "Y"))
  1035.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)
  1036. 20760 IF EC <> 0 THEN _
  1037.          CALL QTPUT1 ("Unable to access "+FILE.NAME.HOLD$) : _
  1038.          CALL UPDTCALR ("Unable to access "+FILE.NAME$,2) : _
  1039.          OK = FALSE : _
  1040.          EC = 0 : _
  1041.          BYTES.IN.FILE# = 0 : _
  1042.          RETURN
  1043.       BYTES.IN.FILE# = LOF(2)
  1044.       NUM.DNLD.BYTS! = LOF(2)
  1045.       OK = TRUE
  1046.       IF SIZE.ONLY THEN _
  1047.          SIZE.ONLY = FALSE : _
  1048.          RETURN
  1049.       BLOCKS.IN.FILE# = MAX.BLOCK
  1050.       IF BATCH.TRANSFER THEN _
  1051.          TEMP# = BATCH.BLOCKS# + BLOCKS.IN.FILE# : _                 ' KG081502
  1052.          CALL CHKTREMAIN (TIME.REMAINING!) : _                       ' KG081502
  1053.          IF (INT(TEMP# / 60) + 1) > INT(TIME.REMAINING!) THEN _      ' KG081502
  1054.             CALL QTPUT1 ("Omitting " + FILE.NAME.HOLD$ + ".  Insufficient time") : _ ' KG081502
  1055.             RETURN _                                                 ' KG081502
  1056.          ELSE BATCH.BLOCKS# = TEMP# : _                              ' KG081502
  1057.               BATCH.BYTES# = BATCH.BYTES# + BYTES.IN.FILE# : _       ' KG081502
  1058.               CALL OPENWRKA (NODE.WORK.FILE$) : _                    ' KG081502
  1059.               CALL PRNTWRKA (FILE.NAME$) : _                         ' KG081502
  1060.               RETURN                                                 ' KG081502
  1061. 20780 A$ = "File Size    :"
  1062.       OK = TRUE
  1063.       IF BLOCK.SIZE > 0 THEN _
  1064.          A$ = A$ + _
  1065.               STR$(FIX(BLOCKS.IN.FILE#)) + _
  1066.               " blocks "
  1067. 20785 BLOCKS.IN.FILE# = BLOCKS.IN.FILE# / _
  1068.                         VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4))
  1069.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / SPEED.FACTOR!
  1070.       IF (ANS.INDEX > 1 AND CONCAT.FILES) THEN _                     ' KG081201
  1071.          RETURN
  1072.       A$ = A$ + _
  1073.            STR$(BYTES.IN.FILE#) + _
  1074.            " bytes"
  1075.       GOSUB 21650
  1076.       IF FILESYS.PARAMETER > 1 THEN _
  1077.          RETURN
  1078.       IF BYTES.IN.FILE# < 1 THEN _
  1079.          RETURN
  1080. 20790 SUBROUTINE.PARAMETER = 2
  1081.       CALL LINE25
  1082.       A$ = "Transfer Time:" + _
  1083.          STR$(INT(BLOCKS.IN.FILE# / 60)) + _
  1084.          " min," + _
  1085.          STR$(INT(BLOCKS.IN.FILE# - (INT(BLOCKS.IN.FILE# / 60) * 60))) + _
  1086.          " sec (approx)"
  1087.       GOSUB 21650
  1088.       IF FILESYS.PARAMETER > 1 THEN _
  1089.          RETURN
  1090. 20791 IF PERSONAL.DOWNLOAD THEN _
  1091.          RETURN
  1092.       CALL CHKTREMAIN (TIME.REMAINING!)
  1093.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1094.          FILESYS.PARAMETER = 6 : _
  1095.          RETURN
  1096.       OK = TRUE
  1097.       IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
  1098.          A$ = "Not enough time left!" : _
  1099.          CALL UPDTCALR (FILE.NAME$ + " " + A$,2) : _
  1100.          CALL QTPUT1 (A$): _
  1101.          A$ = "" : _
  1102.          OK = FALSE : _
  1103.          RETURN
  1104. CALL AUTOLOGOFF           'Autologoff mod
  1105.       CALL CHECKRATIO (TRUE)
  1106. '
  1107. '
  1108. ' *** Tell-m.mod as of 09/10/89****** Pete E
  1109. '
  1110. '
  1111. If NOT OK THEN _
  1112.   RETURN                 'Pe 08/27/89
  1113. '
  1114.     NOTIFY$ =  WELCOME.FILE.DRV.PATH$ + _
  1115.      "TELTHEM.DEF"        ' <==== NOTE SPELLING
  1116. CALL FINDIT (NOTIFY$)
  1117.  IF OK THEN _
  1118.      STOP.INTERRUPTS = TRUE : _
  1119.      CALL BUFFILE (NOTIFY$,X)
  1120. '***************************************
  1121.       RETURN
  1122. 20810 CALL SETABORT (DELAY!,6)
  1123. 20840 CALL EOFCOMM (CHAR%)
  1124.       IF CHAR% = -1 THEN _
  1125.          GOTO 20850
  1126.       CALL FLUSHCOM(Y$)
  1127.       RETURN
  1128. 20850 CALL CHECKTIM (DELAY!)
  1129.       ON SUBROUTINE.PARAMETER GOTO 20840,20851
  1130. 20851 Y$ = ""
  1131.       CALL CHKCARRIER                                                ' KG061203
  1132.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1133.          FILESYS.PARAMETER = 7 : _
  1134.          RETURN
  1135.       RETURN
  1136. '
  1137. ' *  XMODEM/YMODEM UPLOAD
  1138. '
  1139. 20860 GOSUB 20992
  1140.       IF FILESYS.PARAMETER > 1 THEN _
  1141.          RETURN
  1142.       IF NOT EIGHT.BIT THEN _
  1143.          GOSUB 21280 : _
  1144.          IF FILESYS.PARAMETER > 1 THEN _
  1145.             RETURN
  1146. 20900 X$ = ""
  1147.       SEC = 1
  1148.       'CALL OPENOUTW (FILE.NAME$)
  1149.       IF FLEN > WRITE.BUF.DEF THEN _
  1150.          WRITE.BUF = FLEN _
  1151.       ELSE WRITE.BUF = WRITE.BUF.DEF
  1152.       CALL OPENRSEQ (FILE.NAME$,Y,DF,WRITE.BUF)
  1153.       IF EC <> 0 AND EC <> 53 THEN _
  1154.          EL = 20900 : _
  1155.          GOTO 21900
  1156.       FIELD #2, WRITE.BUF AS UPLOAD.RECORD$
  1157.       RECS.WRIT = 0
  1158.       NUM.IN.BUFF = 0
  1159.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1160.       YY$ = " " + _
  1161.             CHR$(1) + _
  1162.             CHR$(2) + _
  1163.             END.TRANSMISSION$ + _
  1164.             CANCEL$
  1165. 20903 CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1166. 20920 X = 1
  1167. 20922 CALL CHKCARRIER                                                ' KG061203
  1168.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1169.          FILESYS.PARAMETER = 7 : _
  1170.          RETURN
  1171.       CALL FINDFUNC
  1172.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1173.          GOSUB 20510 :_
  1174.          IF FILESYS.PARAMETER > 1 THEN _
  1175.             RETURN _
  1176.          ELSE GOTO 21240
  1177.       GOSUB 20810
  1178.       IF FILESYS.PARAMETER > 1 THEN _
  1179.          RETURN
  1180. 20930 J = INSTR(YY$,LEFT$(Y$,1))
  1181.       ON J GOTO 20960,20999,20999,21220,21230
  1182. 20960 IF Y$ <> "" THEN _
  1183.          GOSUB 21280 : _
  1184.          IF FILESYS.PARAMETER > 1 THEN _
  1185.             RETURN _
  1186.          ELSE CALL CHECKTIM (TRANSFER.ABORT!) : _
  1187.               ON SUBROUTINE.PARAMETER GOTO 20920,21230
  1188. 20970 X = X + 1
  1189.       CALL DELAYIT (1)
  1190.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1191.       IF X < 6 THEN _
  1192.          GOTO 20922
  1193.       D$ = "Upload Timeout"
  1194.       GOSUB 21710
  1195.       IF FILESYS.PARAMETER > 1 THEN _
  1196.          RETURN
  1197.       CALL CHECKTIM (TRANSFER.ABORT!)
  1198.       ON SUBROUTINE.PARAMETER GOTO 20990,21230
  1199. 20990 GOTO 20920
  1200. '
  1201. ' *  CHANGE TO 8 BIT FOR XMODEM
  1202. '
  1203. 20992 GOSUB 20510
  1204.       IF FILESYS.PARAMETER > 1 THEN _
  1205.          FILESYS.PARAMETER = 2 : _
  1206.          RETURN
  1207.       IF NOT EIGHT.BIT THEN _
  1208.          PREV.LINE.CONTROL = INP (LINE.CONTROL.REGISTER) : _
  1209.          CALL DELAYIT (3) : _
  1210.          SWITCHED.TO.EIGHT = TRUE : _
  1211.          OUT LINE.CONTROL.REGISTER,3
  1212. 20996 SO = 0
  1213.       RETURN
  1214. '
  1215. ' *  EXPECTED BLOCK LENGTH. 132 FOR CHECKSUM, 133 FOR CRC, 1029 FOR YMODEM
  1216. '
  1217. 20999 SOL = 896 * J - 1659 + CHECKSUM
  1218.       DATA.SOL = 128 - (SOL > 1024)*896
  1219.       GOTO 21020
  1220. '
  1221. ' *  XMODEM/YMODEM UPLOAD
  1222. '
  1223. 21000 GOSUB 20810
  1224.       IF FILESYS.PARAMETER > 1 THEN _
  1225.          RETURN
  1226.       IF Y$ = "" THEN _
  1227.          D$ = "Upload Timeout" : _
  1228.          GOSUB 21710 : _
  1229.          IF FILESYS.PARAMETER > 1 THEN _
  1230.             RETURN _
  1231.          ELSE GOTO 21040
  1232. 21020 X$ = X$ + _
  1233.            Y$
  1234.       IF LEN(X$) < SOL THEN _
  1235.          GOTO 21000
  1236. 21040 IF LEN(X$) = SOL THEN _
  1237.          GOTO 21090
  1238. 21050 IF LEN(X$) > SOL THEN _
  1239.          GOTO 21180
  1240. 21060 IF X$ = END.TRANSMISSION$ THEN _
  1241.          GOTO 21220
  1242. 21070 IF X$ = CANCEL$ THEN _
  1243.          GOTO 21230
  1244. 21080 GOTO 21170
  1245. 21090 JX = ASC(MID$(X$,2,1))
  1246.       IF SEC = JX THEN _
  1247.          GOTO 21100
  1248.       IF SEC > JX THEN _
  1249.          CALL PUTCOM (RIGHT$(ACKC$,1 - (JX = 0))) : _
  1250.          GOTO 21150
  1251.       GOTO 21200
  1252. 21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
  1253.          GOTO 21210
  1254. 21110 IF CHECKSUM THEN _
  1255.          WK$ = MID$(X$,4,128) : _
  1256.          GOSUB 21750 : _
  1257.          IF FILESYS.PARAMETER > 1 THEN _
  1258.             RETURN _
  1259.          ELSE IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
  1260.             GOTO 21190 _
  1261.          ELSE GOTO 21120
  1262.       WK$ = MID$(X$,4)
  1263.       GOSUB 21750
  1264.       IF FILESYS.PARAMETER > 1 THEN _
  1265.          RETURN
  1266. 21113 IF CRC.VALUE <> 0 THEN _
  1267.          GOTO 21191
  1268. 21120 SO = SO + 1
  1269.       CALL PUTCOM (ACKNOWLEDGE$)
  1270. 21131 IF NUM.IN.BUFF >= WRITE.BUF THEN _
  1271.          NUM.IN.BUFF = 0 : _
  1272.          CALL PUTWORK (UPLOAD.RECORD$,RECS.WRIT,WRITE.BUF) : _
  1273.          IF EC <> 0 THEN _
  1274.             EL = 21131 : _
  1275.             GOTO 21900
  1276.       MID$(UPLOAD.RECORD$,NUM.IN.BUFF+1,DATA.SOL) = WK$
  1277.       NUM.IN.BUFF = NUM.IN.BUFF + DATA.SOL
  1278. 21145 SEC = 255 AND (SEC + 1)
  1279.       CALL QLPRNT ("OK Rec Blk #",SO)
  1280. 21150 X$ = ""
  1281.       XMODEM.CHECKSUM = 0
  1282.       CALL SETABORT(TRANSFER.ABORT!,45)
  1283.       GOTO 20920
  1284. 21170 A$ = "Short Blk #"
  1285.       GOTO 21212
  1286. 21180 A$ = "Long Blk #"
  1287.       GOTO 21212
  1288. 21190 A$ = "Chksum Error #"
  1289.       GOTO 21212
  1290. 21191 A$ = "CRC Error"
  1291.       GOTO 21212
  1292. 21200 A$ = "Blk # Error in #"
  1293.       JX = ASC(MID$(X$,2,1))
  1294.       IF SEC < JX THEN _
  1295.          GOTO 21212
  1296.       CALL PUTCOM (ACKNOWLEDGE$) ' RIGHT$(ACKC$,1 - (JX = 0)))
  1297.       GOTO 21150
  1298. 21210 A$ = "Complement Error in #"
  1299. 21212 GOSUB 21280
  1300.       IF FILESYS.PARAMETER > 1 THEN _
  1301.          RETURN
  1302.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1303.       CALL LPRNT(LINE.FEED$ + A$ + STR$(SO + 1),0)
  1304.       GOTO 21150
  1305. 21220 IF NUM.IN.BUFF < 1 THEN _
  1306.          GOTO 21225
  1307.       WK$ = LEFT$(UPLOAD.RECORD$,NUM.IN.BUFF)
  1308.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,128)
  1309.       FIELD #2, 128 AS UPLOAD.RECORD$
  1310.       MAX.BLOCK = CDBL(RECS.WRIT) * WRITE.BUF / 128
  1311.       FOR I = 1 TO NUM.IN.BUFF/128
  1312.          CALL PUTWORK (MID$(WK$,128*I-127,128),MAX.BLOCK,128)
  1313.          IF EC > 0 THEN _
  1314.             EL = 21220 : _
  1315.             GOTO 21900
  1316.       NEXT
  1317.       CLOSE 2
  1318. 21225 CALL PUTCOM (ACKNOWLEDGE$)
  1319.       GOTO 21250
  1320. 21230 D$ = LINE.FEED$ + _
  1321.            "Transfer Aborted"
  1322.       GOSUB 21710
  1323.       IF FILESYS.PARAMETER > 1 THEN _
  1324.          RETURN
  1325. 21240 CALL EOFCOMM (CHAR%)
  1326.       IF CHAR% <> -1 THEN _
  1327.          GOSUB 21280 : _
  1328.          IF FILESYS.PARAMETER > 1 THEN _
  1329.             RETURN _
  1330.          ELSE CALL DELAYIT (1) : _
  1331.          GOTO 21240
  1332.       CALL PUTCOM (CANCEL$ + CANCEL$)
  1333.       CALL DELAYIT (1)
  1334.       CALL EOFCOMM (CHAR%)
  1335.       IF CHAR% <> -1 THEN _
  1336.          GOTO 21240
  1337.       OK = FALSE
  1338. 21250 EIGHT.BIT = TRUE
  1339.       RETURN
  1340. '
  1341. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1342. '
  1343. 21280 CALL CHKCARRIER                                                ' KG061203
  1344.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1345.          FILESYS.PARAMETER = 7 : _
  1346.          RETURN
  1347.       CALL EOFCOMM (CHAR%)
  1348.       IF CHAR% = -1 THEN _
  1349.          RETURN
  1350. 21281 CALL FLUSHCOM(DF$)
  1351.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1352.          FILESYS.PARAMETER = 7 : _                                   ' KG081201
  1353.          RETURN
  1354.       GOTO 21280
  1355. '
  1356. ' *  XMODEM/YMODEM DOWNLOAD
  1357. '
  1358. 21300 GOSUB 20992
  1359.       IF FILESYS.PARAMETER > 1 THEN _
  1360.          RETURN
  1361.       SEC = 0
  1362.       GOSUB 21280
  1363.       IF FILESYS.PARAMETER > 1 THEN _
  1364.          RETURN
  1365.       NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  1366.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1367.    CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)  'Pe 08/15/89
  1368. 21303 FIELD 2,FLEN AS DOWNLOAD.RECORD$
  1369. '
  1370. ' *  ROUTINE TO START AN "XMODEM" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1371. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1372. ' *           "X" = XMODEM WITH CHECKSUM AND 128 CHARACTER RECORDS
  1373. ' *           "C" = XMODEM WITH CRC CHECK AND 128 CHARACTER RECORDS
  1374. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1375. '
  1376. 21350 CALL EOFCOMM (CHAR%)
  1377.       WHILE CHAR% <> -1
  1378. 21360    CALL GETCOM(Y$)
  1379.          IF Y$ = CANCEL$ THEN _
  1380.             GOTO 21560
  1381. 21380    CHECKSUM = (Y$ = NEGATIVE.ACKNOWLEDGE$)
  1382.          IF CHECKSUM THEN _
  1383.             FF = INSTR(INTERNAL.EQUIV$,"X") : _
  1384.             IF FF > 0 THEN _
  1385.                FT$ = MID$(DFLTXFER$,FF,1) : _
  1386.                GOTO 21480 _
  1387.             ELSE FT$ = "X" : _
  1388.                  GOTO 21480 _
  1389.          ELSE IF Y$ = "C" THEN _
  1390.                  GOTO 21480
  1391.          CALL EOFCOMM (CHAR%)
  1392. 21390 WEND
  1393.       GOSUB 21460
  1394.       IF FILESYS.PARAMETER > 1 THEN _
  1395.          RETURN
  1396.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1397.          RETURN
  1398.       CALL CHECKTIM (TRANSFER.ABORT!)
  1399.       ON SUBROUTINE.PARAMETER GOTO 21350,21455
  1400. 21410 CALL SETABORT (TRANSFER.ABORT!, WAIT.BEFORE.DISCONNECT)
  1401. '
  1402. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "XMODEM" OR "YMODEM"
  1403. ' *  DOWNLOAD
  1404. '
  1405. 21415 CALL EOFCOMM (CHAR%)
  1406.       IF CHAR% <> -1 THEN _
  1407.          GOTO 21420
  1408.       GOSUB 21460
  1409.       IF FILESYS.PARAMETER > 1 THEN _
  1410.          RETURN
  1411.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1412.          RETURN
  1413.       CALL CHECKTIM (TRANSFER.ABORT!)
  1414.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1415. 21420 CALL GETCOM(Y$)
  1416.       IF Y$ = ACKNOWLEDGE$ THEN _
  1417.          GOTO 21470
  1418. 21440 IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
  1419.          GOTO 21450
  1420. 21443 D$ = LINE.FEED$ + _
  1421.          "Error -> retrans #" + _
  1422.          STR$(SO)
  1423.       GOSUB 21710
  1424.       IF FILESYS.PARAMETER > 1 THEN _
  1425.          RETURN
  1426. 21445 SO = SO - 1
  1427.       GOTO 21490
  1428. 21450 IF Y$ = CANCEL$ THEN _
  1429.          IF HAVE.A.CANCEL THEN _
  1430.             GOTO 21560 _
  1431.          ELSE HAVE.A.CANCEL = TRUE
  1432.       CALL CHECKTIM (TRANSFER.ABORT!)
  1433.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1434. 21455 D$ = "Download timeout"
  1435.       GOSUB 21710
  1436.       IF FILESYS.PARAMETER > 1 THEN _
  1437.          RETURN
  1438.       GOTO 21560
  1439. 21460 CALL CHKCARRIER                                                ' KG061203
  1440.       CALL FINDFUNC
  1441.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1442.          FILESYS.PARAMETER = 7 : _
  1443.          RETURN
  1444.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1445.          GOTO 21540
  1446.       RETURN
  1447. '
  1448. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1449. '
  1450. 21470 CALL QLPRNT ("OK Sent Blk #",SO)
  1451. 21480 IF LOC(2) => MAX.BLOCK THEN _
  1452.          GOTO 21530
  1453.       CALL GETWORK (FLEN)
  1454.       IF EC <> 0 THEN _
  1455.          EL = 21480 : _
  1456.          GOTO 21900
  1457.       SEC = 255 AND (SEC + 1)
  1458.       GOTO 21490
  1459. '
  1460. ' *  ROUTINE TO WRITE OUT AN "XMODEM" OR "YMODEM" RECORD TO THE COMM. PORT
  1461. '
  1462. 21490 SO = SO + 1
  1463.       CALL PUTCOM (START.OF.HEADER$ + CHR$(SEC) + CHR$(SEC XOR 255))
  1464.       CALL PUTCOM (DOWNLOAD.RECORD$)
  1465.       HAVE.A.CANCEL = FALSE
  1466. 21503 WK$ = DOWNLOAD.RECORD$
  1467. 21504 GOSUB 21750
  1468.       IF FILESYS.PARAMETER > 1 THEN _
  1469.          RETURN
  1470. 21510 IF CHECKSUM THEN _
  1471.          CALL PUTCOM(CHR$(XMODEM.CHECKSUM)) _
  1472.       ELSE CALL PUTCOM(CHR$(CRC.HIGH) + CHR$(CRC.LOW))
  1473.       GOSUB 21280
  1474.       IF FILESYS.PARAMETER > 1 THEN _
  1475.          RETURN
  1476.       GOTO 21410
  1477. '
  1478. ' *  END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP
  1479. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1480. ' *  RE-TRY UP TO 10 TIMES.  IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1481. ' *  ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1482. '
  1483. 21530 CALL PUTCOM (END.TRANSMISSION$)
  1484.       X = 1
  1485. 21531 GOSUB 20810
  1486.       IF FILESYS.PARAMETER > 1 THEN _
  1487.          RETURN
  1488.       IF INSTR(Y$,ACKNOWLEDGE$) THEN _
  1489.          GOTO 21550
  1490.       CALL FINDFUNC
  1491.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1492.          FILESYS.PARAMETER = 2 : _
  1493.          RETURN
  1494.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1495.          GOSUB 21540 : _
  1496.          GOTO 21545
  1497.       IF X < 10 THEN _
  1498.          X = X + 1 : _
  1499.          GOTO 21531
  1500.       DOWNLOAD.COMPLETED = FALSE
  1501.       GOTO 21230
  1502. 21540 GOSUB 20510
  1503.       IF FILESYS.PARAMETER > 1 THEN _
  1504.          RETURN
  1505.       RETURN
  1506. 21545 Y$ = CANCEL$
  1507.       CALL PUTCOM (CANCEL$ + CANCEL$ + CANCEL$)
  1508.       DOWNLOAD.COMPLETED = FALSE
  1509.       GOTO 21250
  1510. 21550 DOWNLOAD.COMPLETED = TRUE
  1511.       GOTO 21250
  1512. 21560 DOWNLOAD.COMPLETED = FALSE
  1513.       D$ = LINE.FEED$ + _
  1514.            "Caller aborted trans"
  1515.       GOSUB 21710
  1516.       IF FILESYS.PARAMETER > 1 THEN _
  1517.          RETURN
  1518.       GOTO 21545
  1519. '
  1520. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1521. '
  1522. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1523. 21630 SUBROUTINE.PARAMETER = 1
  1524.       GOTO 21655
  1525. 21640 SUBROUTINE.PARAMETER = 3
  1526.       GOTO 21655
  1527. 21650 SUBROUTINE.PARAMETER = 5
  1528. 21655 CALL TPUT
  1529.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1530.          FILESYS.PARAMETER = 2 : _
  1531.          RETURN
  1532.       IF SUBROUTINE.PARAMETER = 8 THEN _
  1533.          GOSUB 21660
  1534.       RETURN
  1535. '
  1536. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1537. '
  1538. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1539. 21660 SUBROUTINE.PARAMETER = 1
  1540.       CALL TGET
  1541. 21665 IF SUBROUTINE.PARAMETER < 0 THEN _                             ' KG081201
  1542.          FILESYS.PARAMETER = 2
  1543.       RETURN
  1544. 21668 CALL POPCSTACK                                                 ' KG081201
  1545.       GOTO 21665                                                     ' KG081201
  1546. 21700 EC = 0
  1547.       RETURN
  1548. '
  1549. ' **** COMMON LOCAL DISPLAY PRINT ***
  1550. '
  1551. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS CPC16-1A
  1552. 21710 NUM.RETURNS = 1
  1553. 21720 CALL LPRNT (D$,NUM.RETURNS)
  1554.       RETURN
  1555. '
  1556. ' *  XMODEM / CRC INTERFACE
  1557. '
  1558. '  (formerly line 46000 in RBBS-PC.BAS CPC16-1A
  1559. 21750 XMODEM.CHECKSUM = 0
  1560.       CRC.VALUE = 0
  1561.       CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
  1562.       RETURN
  1563. '
  1564. ' * UPDATE DOWNLOAD STATISTICS
  1565. '
  1566. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS CPC16-1A
  1567. 21760 GOSUB 21780
  1568.       IF FILESYS.PARAMETER > 1 THEN _
  1569.          RETURN
  1570.       IF BATCH.TRANSFER THEN _
  1571.          CALL LINESNFIL (NODE.WORK.FILE$,DOWN.FILES) _
  1572.       ELSE DOWN.FILES = 1
  1573.       IF NOT DOWNLOAD.COMPLETED THEN _
  1574.          AUTO.LOGOFF = FALSE : _
  1575.          DF$ = " Aborted" _
  1576.       ELSE CALL LOGDOWN (PERSONAL.DOWNLOAD,1+ANS.INDEX-FIRST.DOWNLOAD) : _  ' KG082601
  1577.            DOWNLOADS = DOWNLOADS + DOWN.FILES : _
  1578.            GLOBAL.DL.TODAY! = GLOBAL.DL.TODAY! + DOWN.FILES : _
  1579.            GLOBAL.DOWNLOADS = GLOBAL.DOWNLOADS + DOWN.FILES : _
  1580.            DLBYTES! = DLBYTES! + NUM.DNLD.BYTS! : _
  1581.            GLOBAL.DLBYTES! = GLOBAL.DLBYTES! + NUM.DNLD.BYTS! : _
  1582.            DL.TODAY! = DL.TODAY! + DOWN.FILES : _
  1583.            BYTES.TODAY! = BYTES.TODAY! + NUM.DNLD.BYTS! : _
  1584.            GLOBAL.BYTES.TODAY! = GLOBAL.BYTES.TODAY! + NUM.DNLD.BYTS! : _ ' KG102004
  1585.            NUM.DNLD.BYTS! = 0 : _
  1586.            CALL MUZAK (6) : _
  1587.            DF$ = " Downloaded" : _
  1588.            IF (ANS.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _ ' KG081201
  1589.               CALL SKIPLINE (1) : _
  1590.               CALL QTPUT1 ("Download successful")
  1591.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  1592.          DF$ = " AUTO" + _
  1593.               MID$(N$,2)
  1594.       IF INSTR(N$,"Aborted") THEN _
  1595.          AUTODOWNLOAD.IN.PROGRESS = 0
  1596.       A$ = ""
  1597. 21770 CALL AMORPM                                                    ' KG061203
  1598.       IF NOT BATCH.TRANSFER THEN _
  1599.          GOTO 21773
  1600.       CALL OPENWORK (2,NODE.WORK.FILE$)
  1601.       IF EC > 0 THEN _
  1602.          RETURN
  1603.       Q = 0
  1604.       WHILE NOT EOF(2)
  1605.          CALL READANY
  1606.          Q = Q + 1
  1607.          B$(Q) = A$
  1608.       WEND
  1609. 21772 IF Q < 1 THEN _
  1610.          BATCH.TRANSFER = FALSE : _
  1611.        CALL CHECKRATIO (FALSE):_
  1612.          RETURN
  1613.       CALL OPENWORK (2,B$(Q))
  1614.       IF EC > 0 THEN _
  1615.          EC = 0 : _
  1616.          Q = Q - 1 : _
  1617.          GOTO 21772
  1618.       BYTES.IN.FILE# = LOF(2)
  1619.       FILE.NAME$ = B$(Q)
  1620. 21773 CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE)
  1621.       Z$ = X$ + _
  1622.            EXTENTION$ + _
  1623.            DF$ + _
  1624.            " at " + _
  1625.            TIM$ + _
  1626.            " using " + _
  1627.            FT$ + _
  1628.            STR$(BYTES.IN.FILE#)
  1629.       CALL UPDTCALR (Z$,2)
  1630.       IF BATCH.TRANSFER THEN _
  1631.          Q = Q - 1 : _
  1632.          GOTO 21772
  1633.       CALL CHECKRATIO (FALSE)
  1634. 21774 IF MENU.INDEX = 6 THEN _
  1635.          IF DOWNLOAD.COMPLETED THEN _
  1636.             A$ = X$ : _
  1637.             SUBROUTINE.PARAMETER = 5 : _
  1638.             CALL LIBRARY
  1639.       RETURN
  1640. '
  1641. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1642. '
  1643. '  (formerly line 50620 in RBBS-PC.BAS CPC16-1A
  1644. 21780 IF ECHOER$ = "I" THEN _
  1645.          CALL SETECHO ("I")
  1646. '
  1647. ' *  RESTORE COMMUNICATIONS AFTER SWITCH TO 8 BIT
  1648. '
  1649. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS CPC16-1A
  1650.       IF SWITCHED.TO.EIGHT THEN _
  1651.          IF SWITCH.BACK THEN _
  1652.             OUT LINE.CONTROL.REGISTER, PREV.LINE.CONTROL : _
  1653.             CALL DELAYIT (3) : _
  1654.             EIGHT.BIT = FALSE : _
  1655.             SWITCHED.TO.EIGHT = FALSE
  1656.       RETURN
  1657. '
  1658. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1659. '
  1660. '  (formerly line 50630 in RBBS-PC.BAS CPC16-1A
  1661. 21790 IF ECHOER$ = "I" THEN _
  1662.          CALL SETECHO ("R")
  1663.       RETURN
  1664. '
  1665. ' *****   DIRECTORY SEARCH   ****
  1666. '
  1667. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS CPC16-1A
  1668. 21800 CK = 2                                                         ' KG081201
  1669. 21810 A$ = "Search for (in file name/desc, wildcards name only, [ENTER] quits)"
  1670.       MACRO.MIN = 99
  1671.       GOSUB 21668                                                    ' KG081201
  1672.       IF Q = 0 THEN _
  1673.          RETURN
  1674. 21820 RS$ = B$(ANS.INDEX)                                            ' KG081201
  1675.       WILD.SEARCH = (INSTR(RS$,"*") > 0 OR INSTR(RS$,"?") > 0)
  1676.       CALL ALLCAPS (RS$)
  1677.       SEARCH.STRING$ = RS$
  1678.       SEARCH.DATE$ = ""
  1679.       A1$ = RS$
  1680.       GOTO 21867
  1681. '
  1682. ' *****  P - personal download  ****
  1683. '
  1684. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS CPC16-1A
  1685. 21850 IF PERSONAL.BEGIN < 1 OR PERSONAL.LEN < 1 THEN _
  1686.          RETURN
  1687.       DOWNLOAD.FLAG = 0
  1688.       PERSONAL.DOWNLOAD = TRUE
  1689. 21852 CALL PERSFILE (MID$(USER.RECORD$,PERSONAL.BEGIN,PERSONAL.LEN),_
  1690.                      DOWNLOAD.FLAG)
  1691.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1692.          FILESYS.PARAMETER = 7: _
  1693.          RETURN
  1694.       IF LAST.INDEX <= 0 THEN _                                      ' KG082601
  1695.          GOTO 21854
  1696.       CONCAT.FILES = PERSONAL.CONCAT
  1697.       STOP.INTERRUPTS = TRUE
  1698.       TIME.LOCK.EXEMPT = TRUE
  1699.       GOSUB 20202
  1700.       IF FILESYS.PARAMETER > 1 THEN _
  1701.          GOTO 21854
  1702.       TIME.LOCK.EXEMPT = FALSE
  1703.       CONCAT.FILES = FALSE
  1704.       GOTO 21852
  1705. 21854 PERSONAL.DOWNLOAD = FALSE
  1706.       RETURN
  1707. '
  1708. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY)
  1709. '
  1710. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS CPC16-1A
  1711. 21860 CK = 1                                                         ' KG081201
  1712. 21862 A1$ = RIGHT$(LM$,4) +_
  1713.             LEFT$(LM$,2)
  1714.       A$ = "Files on/after (MMDDYY, [ENTER] = last on " + _
  1715.            A1$ + _
  1716.            ")"
  1717.       GOSUB 21668                                                    ' KG081201
  1718.       IF Q = 0 THEN _
  1719.          RS$ = LM$ : _
  1720.          GOTO 21866                                                  ' KG081202
  1721. 21865 IF LEN(B$(ANS.INDEX)) <> 6 THEN _                              ' KG081201
  1722.          GOTO 21862
  1723.       A1$ = B$(ANS.INDEX)                                            ' KG081201
  1724.       RS$ = RIGHT$(A1$,2) + _
  1725.             LEFT$(A1$,4)
  1726. 21866 SEARCH.DATE$ = RS$
  1727.       SEARCH.STRING$ = ""
  1728.       LIST.NEW = TRUE                                    'Pe 09/10/89
  1729. 21867 '
  1730. 21871 B$(1) = "ALL"
  1731.       CALL CONVDIRS (ANS.INDEX)                                      ' KG090205
  1732.       LIST.DIRECTORY = TRUE                                          ' KG083002
  1733.      SEARCHING.ALL = TRUE                             ' Pe 09/10/89
  1734. 21875 Z$ = B$(ANS.INDEX)                                             ' KG081201
  1735.       IF NOT SEARCHING.ALL THEN _                                    ' KG081201
  1736.          IF Z$ = "ALL" THEN _                                        ' KG081201
  1737.             IF NOT LIMIT.SEARCH.TO.FMS THEN _                        ' KG081201
  1738.                GOTO 21890                                            ' KG081201
  1739. 21880 QX = ANS.INDEX                                                 ' KG081201
  1740.       GOSUB 20157                                                    ' KG081201
  1741.       IF FILESYS.PARAMETER > 1 THEN _
  1742.          RETURN
  1743.       ANS.INDEX = ANS.INDEX + 1                                      ' KG081201
  1744.       IF ANS.INDEX <= LAST.INDEX THEN _                              ' KG090205
  1745.          GOTO 21875
  1746.       LIST.NEW = FALSE
  1747.       SEARCH.STRING$ = ""
  1748.       SEARCH.DATE$ = ""
  1749.       RETURN
  1750. 21890 G = ANS.INDEX                                                  ' KG083002
  1751.       CALL GETALL (DIRECTORY.PATH$ + DIRECTORY.PREFIX$ + "." + DIRECTORY.EXTENTION$,B$(),DIRECTORY.EXTENTION$,G)
  1752.       SEARCHING.ALL = TRUE
  1753.       LAST.INDEX = G                                                 ' KG081201
  1754.       ANS.INDEX = ANS.INDEX + 1                                      ' KG081201
  1755.       GOTO 20157                                                     ' KG081201
  1756. '
  1757. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1758. '
  1759. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS CPC16-1A
  1760. 21900 IF DEBUG THEN _
  1761.          A$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1762.               STR$(EL) + _
  1763.               " ERR=" + _
  1764.               STR$(EC) : _
  1765.          IF PRINTER THEN _
  1766.             CALL PRINTIT(A$) _
  1767.          ELSE CALL LPRNT(A$,1)
  1768.       IF EL = 20126 AND EC = 53 THEN _
  1769.          GOTO 20142
  1770.       IF EL = 20242 AND EC = 62 THEN _
  1771.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  1772.          GOTO 20247
  1773.       IF EL = 20262 THEN _
  1774.          A$ = "<Download aborted>" : _
  1775.          DOWNLOAD.COMPLETED = FALSE : _
  1776.          GOTO 20390
  1777.       IF EL = 20452 AND EC = 53 THEN _
  1778.          GOTO 20451
  1779.       IF EL = 20560 AND EC = 67 THEN _
  1780.          GOTO 20451
  1781.       IF EL = 20560 AND EC = 70 THEN _
  1782.          IF VAL(FREE.SPACE$) > 1999 THEN _
  1783.             GOTO 20610 _
  1784.          ELSE CALL QTPUT1 ("No room for uploads. Try tomorrow.") : _
  1785.               GOTO 21700
  1786.       IF EL = 20620 THEN _
  1787.          GOTO 20670
  1788.       IF EL = 20650 THEN _
  1789.          GOTO 20670
  1790.       IF EL = 20736 AND EC = 53 THEN _
  1791.          GOTO 21700
  1792.       IF EL = 20900 AND EC = 75 THEN _
  1793.          GOTO 21230
  1794.       IF EL = 20900 AND EC = 70 THEN _
  1795.          CALL QTPUT1 ("No room for uploads. Try tomorrow.") : _
  1796.          GOTO 21230
  1797.       IF EL = 21131 OR EL = 21220 THEN _
  1798.          EC = 0 : _
  1799.          GOTO 21230
  1800.       IF EL = 21480 THEN _
  1801.          CALL LOGERROR : _
  1802.          IF EC = 57 THEN _
  1803.             CALL QTPUT1 ("Error reading file.  Aborting download") : _
  1804.             DOWNLOAD.COMPLETED = FALSE : _
  1805.             GOTO 21230
  1806. 21910 CALL LOGERROR
  1807.       CALL QTPUT1 (CALLERS.RECORD$)
  1808.       FILESYS.PARAMETER = 3
  1809.       RETURN
  1810. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1811.       END SUB
  1812. ' $SUBTITLE: 'GETCOLOR - subroutine to see if user wants color'
  1813. ' $PAGE
  1814. '
  1815.   SUB GETCOLOR STATIC
  1816. '******************************************************************************
  1817. '* Find out if user wants COLOR before getting name                           *
  1818. '*                                                                            *
  1819. '* The color values are as follows                                            *
  1820. '* CX$(1)= red   CX$(2) = GREEN      CX$(3) = YELLOW       CX$(4) = BLUE      *
  1821. '* CX$(5)= MAGENTA  CX$(6) = CYAN   CX$(7) = WHITE       CX$(8)= BRT.WHITE    *
  1822. '*                                                                            *
  1823. '******************************************************************************
  1824. '
  1825. 21935 'CALL SKIPLINE(2)
  1826.     'A$ = CHR$(7)+"Do you want IBM Color (Y/[N]) "
  1827.     'TURBO.KEY = T.KEY
  1828.     'CALL TGET
  1829.     'IF Q = 0 THEN_
  1830.     '  GOTO 21940
  1831.     'IF NOT YES THEN GOTO 21940
  1832.    IF GR < 2  then GOTO 21940
  1833.     CX$(1) = CHR$(27) + "[01;31;40m": CX$(2) = CHR$(27) + "[01;32;40m"
  1834.     CX$(3) = CHR$(27) + "[01;33;40m": CX$(4) = CHR$(27) + "[01;34;40m"
  1835.     CX$(5) = CHR$(27) + "[01;35;40m": CX$(6) = CHR$(27) + "[01;36;40m"
  1836.     CX$(7) = CHR$(27) + "[01;37;40m": CX$(8) = CHR$(27) + "[01;37;40m"
  1837.     EXIT SUB
  1838. '
  1839. '******************************************************************************
  1840. '*  Turn Off Color if User does Not want it                                   *
  1841. '******************************************************************************
  1842. '
  1843. 21940 '
  1844. CX$(1) = "": CX$(2) = "": CX$(3) = "": CX$(4) = "": CX$(5) = ""
  1845. CX$(6) = "": CX$(7) = "": CX$(8) = ""
  1846. END SUB
  1847. '******************** INSERTED AUTO.LOGOFF here ******************
  1848. '
  1849. ' $SUBTITLE: 'AUTOLOGOFF - Subroutine to  to log off after transfer'
  1850. ' $PAGE
  1851. '
  1852.   SUB AUTOLOGOFF STATIC
  1853.  AUTO.END = 0
  1854.   IF GET.EXT.DESC = TRUE THEN _
  1855.     EXIT SUB
  1856.  SUBROUTINE.PARAMETER = 1
  1857.    A$ = CHR$(7)+CX$(2)+"Auto-"+_
  1858.         CX$(5)+"LogOff"+CX$(2)+" after the transfer"+_
  1859.         CX$(3)+" ?(Y/[N]) "+CX$(7)+CHR$(7)
  1860. CALL QTPUT(A$,0)
  1861.      A$=""
  1862.     TURBO.KEY = -TURBO.KEY.USER
  1863.       CALL TGET
  1864.        IF NOT YES THEN _
  1865.      CALL SKIPLINE (1) : _
  1866.      EXIT SUB 
  1867.  AUTO.END = 1
  1868.  CALL SKIPLINE (1)
  1869. END SUB
  1870. 63100 ' $SUBTITLE: 'DOORRTN - Subroutine to process requests from a door'
  1871. ' $PAGE
  1872. '
  1873. '  NAME    -- DOORRTN
  1874. '
  1875. '  INPUTS  -- PARAMETER                      MEANING
  1876. '             DOUTx.DEF               File of requests
  1877. '
  1878. '  OUTPUTS -- USER.SECURITY.LEVEL     Revised Security Level
  1879. '
  1880. '  PURPOSE -- To give Doors a stable way to make requests
  1881. '             to the host.
  1882. '
  1883.       SUB DOORRTN STATIC
  1884.       IF PRIVATE.DOOR OR NOT EXIT.TO.DOORS THEN _
  1885.          EXIT SUB
  1886.       FILE.NAME$ = "DOUT" + NODE.ID$ + ".DEF"
  1887.       CALL FINDIT (FILE.NAME$)
  1888.       IF NOT OK THEN _
  1889.          EXIT SUB
  1890. 63105 IF EOF(2) THEN _
  1891.          GOTO 63195
  1892.       CALL READPARMS (A$(),2,1)
  1893.       IF EC > 0 THEN _
  1894.          GOTO 63115
  1895.       IF LEN(A$(1)) < 2 THEN _
  1896.          EXIT SUB
  1897.       B$ = LEFT$(A$(1),2) + ","
  1898.       X = INSTR("SL,UR,",B$)
  1899.       IF X = 0 THEN _
  1900.          GOTO 63105
  1901.       X = X\3 + 1
  1902.       ON X GOTO 63110,63115
  1903.       GOTO 63105
  1904. 63110 X$ = LEFT$(A$(2),1)         ' SL = Security Level
  1905.       CALL CHECKINT (A$(2))
  1906.       IF EC > 0 THEN _
  1907.          GOTO 63105
  1908.       IF X$ = "+" OR X$ = "-" THEN _
  1909.          A = USER.SECURITY.LEVEL + TESTED.INTEGER.VALUE _
  1910.       ELSE A = TESTED.INTEGER.VALUE
  1911.       IF A < SYSOP.SECURITY.LEVEL THEN _
  1912.          ADJUSTED.SECURITY = (A <> USER.SECURITY.LEVEL) : _
  1913.          IF ADJUSTED.SECURITY THEN _
  1914.             USER.SECURITY.LEVEL = A : _
  1915.             MID$(USER.RECORD$,47,2) = MKI$(A) : _
  1916.             CALL QTPUT1 ("Security changed to" + STR$(A)) : _
  1917.             CALL UPDTCALR ("Door reset security to "+STR$(A),2)
  1918.       GOTO 63105
  1919. 63115 IF LEN(A$(1)) < 7 THEN _
  1920.          GOTO 63105
  1921.       IF MID$(A$(1),3,1) <> "(" THEN _
  1922.          GOTO 63105
  1923.       X = INSTR(4,A$(1),":")
  1924.       IF X < 1 THEN _
  1925.          GOTO 63105
  1926.       CALL CHECKINT (MID$(A$(1),4,X-4))
  1927.       IF EC > 0 THEN _
  1928.          GOTO 63105
  1929.       IF TESTED.INTEGER.VALUE > 128 OR TESTED.INTEGER.VALUE < 1 THEN _
  1930.          GOTO 63105
  1931.       A = TESTED.INTEGER.VALUE
  1932.       CALL CHECKINT (MID$(A$(1),X+1))
  1933.       IF EC > 0 OR TESTED.INTEGER.VALUE < 1 OR TESTED.INTEGER.VALUE > 128 THEN _
  1934.          GOTO 63105
  1935.       MID$(USER.RECORD$,A,TESTED.INTEGER.VALUE) = LEFT$(A$(2) + _
  1936.          SPACE$(TESTED.INTEGER.VALUE),TESTED.INTEGER.VALUE)
  1937.       CALL UPDTCALR ("Door set UR"+STR$(A)+":"+STR$(TESTED.INTEGER.VALUE)+" to <"+A$(2)+">",2)
  1938.       GOTO 63105
  1939. 63195 CALL KILLWORK (FILE.NAME$)
  1940.       EC = 0
  1941.       END SUB
  1942. 63200 ' $SUBTITLE: 'WILDCARD -- Matches string to a pattern'
  1943. ' $PAGE
  1944. '  NAME    -- WILDCARD
  1945. '
  1946. '  INPUTS  -- PARAMETER             MEANING
  1947. '             PATTERN$           PATTERN TO CHECK
  1948. '             STRNG$             STRING TO FIE
  1949. '
  1950. '  OUTPUTS -- OK                 TRUE IF MATCH FOUND
  1951. '                                FALSE IF NO MATCH WAS FOUND
  1952. '
  1953. '  PURPOSE  Determine whether a string is an instance in a pattern
  1954. '           supported patterns are only "?" which requires a
  1955. '           character but can be any, and "*" which matches any-
  1956. '           thing, including a null string.  Anything else in a
  1957. '           sting must be an exact match.  Supports reverse
  1958. '           wildcards.
  1959. '
  1960. '
  1961.       SUB WILDCARD (PATTERN$,STRNG$) STATIC
  1962. 63285 OK = TRUE
  1963.       PATPOS = 0
  1964.       STRPOS = 0
  1965.       INC = 1
  1966.       KT = 0
  1967.       P = LEN(PATTERN$)
  1968.       L = LEN(STRNG$)
  1969. 63286 PATPOS = PATPOS + INC
  1970.       STRPOS = STRPOS + INC
  1971.       KT = KT + 1
  1972.       IF KT > L THEN _
  1973.          GOTO 63288
  1974.       B$ = MID$(PATTERN$,PATPOS,1)
  1975.       IF B$ = "*" THEN _
  1976.          GOTO 63289
  1977. 63287 IF B$ <> "?" AND MID$(STRNG$,STRPOS,1) <> B$ THEN _
  1978.          OK = FALSE : _
  1979.          EXIT SUB
  1980.       GOTO 63286
  1981. 63288 IF PATPOS >= LEN(PATTERN$) OR PATPOS < 1 THEN _
  1982.          EXIT SUB
  1983.       IF MID$(PATTERN$,PATPOS,1) <> "*" THEN _
  1984.          OK = FALSE : _
  1985.          EXIT SUB
  1986. 63289 IF PATPOS <> P THEN _   ' Reverse search
  1987.          INC = -1 : _
  1988.          P = PATPOS : _
  1989.          PATPOS = LEN(PATTERN$) + 1 : _
  1990.          STRPOS = LEN(STRNG$) + 1 : _
  1991.          KT = 0 : _
  1992.          GOTO 63286
  1993.       END SUB
  1994. 63300 ' $SUBTITLE: 'BRKFNAME - sub to split file name into components'
  1995. ' $PAGE
  1996. '
  1997. '  NAME    -- BRKFNAME
  1998. '
  1999. '  INPUTS  -- PARAMETER                    MEANING
  2000. '             FILENAME$        FULL NAME OF FILE
  2001. '             FOR.JOINING      TRUE IF WANT PARTS FORMATTED FOR
  2002. '                                           FORMING FILE NAMES
  2003. '  OUTPUTS -- DRVPATH$         DRIVE AND PATH
  2004. '             PREFIX$          PREFIX OF FILE NAME
  2005. '             EXTENSION$       EXTENSION OF FILE NAME
  2006. '
  2007. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  2008. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  2009. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  2010. '
  2011. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  2012. '
  2013. '  PURPOSE -- To break a file name into its component parts
  2014. '             of drive/path, prefix, and extension
  2015. '
  2016. '
  2017.       SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC
  2018.       CALL ALLCAPS (FILENAME$)
  2019.       DRVPATH$ = ""
  2020.       PREFIX$ = ""
  2021.       EXTENSION$ = ""
  2022.       CALL TRIMTRAIL (FILENAME$,"\")
  2023.       L = LEN(FILENAME$)
  2024.       IF L < 1 THEN _
  2025.          EXIT SUB
  2026.       CALL FINDLAST (FILENAME$,"\",X,Y)
  2027.       IF X < 1 THEN _
  2028.          IF MID$(FILENAME$,2,1) = ":" THEN _
  2029.             DRVPATH$ = LEFT$(FILENAME$,1) : _
  2030.             S = 3 _
  2031.          ELSE S = 1 _
  2032.       ELSE DRVPATH$ = LEFT$(FILENAME$,X-1) : _
  2033.            S = X + 1 : _
  2034.            IF Y = 1 THEN _                                           ' KG061201
  2035.               DRVPATH$ = DRVPATH$ + "\"                              ' KG061201
  2036.       X = INSTR(FILENAME$ + ".",".")
  2037.       IF X < L THEN _
  2038.          EXTENSION$ = MID$(FILENAME$,X + 1,3)
  2039.       IF S <= L THEN _
  2040.          IF X >= S THEN _
  2041.             PREFIX$ = MID$(FILENAME$,S,X - S)
  2042.       IF NOT FOR.JOINING THEN _
  2043.          EXIT SUB
  2044.       IF LEN(DRVPATH$) = 1 THEN _
  2045.          IF DRVPATH$ <> "\" THEN _                                   ' KG061201
  2046.             DRVPATH$ = DRVPATH$ + _                                  ' KG061201
  2047.                        ":"                                           ' KG061201
  2048.       IF INSTR(DRVPATH$,"\") > 0 AND RIGHT$(DRVPATH$,1) <> "\" THEN _ ' KG061201
  2049.          DRVPATH$ = DRVPATH$ + _
  2050.                     "\"
  2051.       IF LEN(EXTENSION$) > 0 THEN _
  2052.          EXTENSION$ = "." + _
  2053.                       EXTENSION$
  2054.       END SUB
  2055. 63310 ' $SUBTITLE: 'RESTORECOM - sub to restore comm port'
  2056. ' $PAGE
  2057. '
  2058. '  NAME    -- RESTORECOM
  2059. '
  2060. '  INPUTS  -- none
  2061. '
  2062. '  OUTPUTS -- none
  2063. '
  2064. '  PURPOSE -- To restore communications port after an external
  2065. '             program may have left it in altered state
  2066. '
  2067.       SUB RESTORECOM STATIC
  2068.       PARITY$ = MID$(",N,8,1,E,7,1",7 + 6 * EIGHT.BIT,6)
  2069.       IF LOCAL.USER THEN _
  2070.          EXIT SUB
  2071.       CALL SETBAUD                                                   ' KG052102
  2072.       IF NOT FOSSIL THEN _                                           ' KG052102
  2073.          CALL OPENCOM(TALK.TO.MODEM.AT$,PARITY$)
  2074.       END SUB
  2075. 63320 ' $SUBTITLE: 'SHELLEXIT - sub to shell out from RBBS'
  2076. ' $PAGE
  2077. '
  2078. '  NAME    -- SHELLEXIT
  2079. '
  2080. '  INPUTS  -- SHELL.TEM$     String to invoke shell with
  2081. '
  2082. '  OUTPUTS -- none
  2083. '
  2084. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  2085. '             port on return
  2086. '
  2087.       SUB SHELLEXIT (SHELL.TEM$) STATIC
  2088.       CALL DELAYIT (8 + BPS)
  2089.       IF FOSSIL THEN _
  2090.          CALL FOSEXIT(COMPORT%) _
  2091.       ELSE CLOSE 3 : _
  2092.            OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  2093.       CLOSE 2
  2094.       CALL METAGSR (SHELL.TEM$,FALSE)
  2095.       SHELL SHELL.TEM$
  2096.       IF FOSSIL THEN _
  2097.          CALL FOSINIT(COMPORT%,RESULT%) : _
  2098.          IF RESULT% = -1 THEN _
  2099.             CALL PSCRN("ERROR INITIALIZING FOSSIL AFTER EXTERNAL PROTOCOL") : _
  2100.             SYSTEM
  2101.       CALL DELAYIT (2)
  2102.       CALL RESTORECOM
  2103.       END SUB
  2104. 63330 ' $SUBTITLE: 'READMACRO - sub to read macro'
  2105. ' $PAGE
  2106. '
  2107. '  NAME    -- READMACRO
  2108. '
  2109. '  INPUTS  -- PARAMETER             MEANING
  2110. '
  2111. '  OUTPUTS -- A$               LINE TO PROCESS IN MACRO
  2112. '             MACRO.ACTIVE     FLAG WHETHER IN A MACRO
  2113. '
  2114. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  2115. '             macro commands, which are:
  2116. '             *0 - display what follows, no carriage return
  2117. '             *1 - display what follows with carriage return
  2118. '             *B - display block that follows
  2119. '             *F - display File
  2120. '             WT - wait specified # of seconds
  2121. '             >> - append following block to specified file
  2122. '             ST - stack following (with carriage return)
  2123. '             ON - define case
  2124. '             == - case value that applies to following block
  2125. '             M! - execute following macro
  2126. '             M@ - abort macro processing
  2127. '             EY - Echo on (yes)
  2128. '             EN - Echo off (no)
  2129. '             /* - comment line skipped in processing
  2130. '             TK - Turbo key on (if user preference)
  2131. '             << - Read from file into a form
  2132. '
  2133.       SUB READMACRO STATIC
  2134.       IF MACRO.TEMPLATE$ <> "" THEN _
  2135.          GOTO 63392
  2136.       IF DISTANT.TGET = 2 THEN _
  2137.          GOTO 63349
  2138. 63336 GOSUB 63395
  2139.       IF NOT MACRO.ACTIVE THEN _
  2140.          MACRO.ECHO = TRUE : _
  2141.          EXIT SUB
  2142.       IF LEN(A$) < 3 THEN _
  2143.          GOTO 63398
  2144.       X$ = RIGHT$(A$,LEN(A$)-3)
  2145.       IF COMPARE.VAR > 0 THEN _
  2146.          IF NOT CASE.EXECUTE THEN _
  2147.             IF LEFT$(A$,3) = SMART.TEXT$+"==" THEN _
  2148.                GOTO 63370 _
  2149.             ELSE IF LEFT$(A$,7) = "{END ON" THEN _
  2150.                     COMPARE.VAR = 0 : _
  2151.                     GOTO 63336 _
  2152.                   ELSE GOTO 63336
  2153.       IF LEFT$(A$,1) <> SMART.TEXT$ THEN _
  2154.          GOTO 63398
  2155.       CALL CHECKINT (MID$(A$,2))
  2156.       IF EC > 0 THEN _
  2157.          GOTO 63398
  2158.       IF TESTED.INTEGER.VALUE > 0 AND TESTED.INTEGER.VALUE <= MAX.WORK.VAR THEN _
  2159.          A$ = X$ : _  ' Macro command ask
  2160.          SUBROUTINE.PARAMETER = 4 : _
  2161.          CALL TPUT : _
  2162.          A$ = "" : _
  2163.          B$ = "" :_
  2164.          FORCE.KEYBOARD = TRUE : _
  2165.          MACRO.SAVE = TESTED.INTEGER.VALUE : _
  2166.          LINES.PRINTED = 1 : _
  2167.          NON.STOP = (PAGE.LENGTH < 1) : _                            ' KG072603
  2168.          EXIT SUB
  2169.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<",MID$(A$,2,2)))\2 GOTO _
  2170.          63345, _  ' Display with no Carriage Return
  2171.          63347, _  ' Display with Carriage Return
  2172.          63340, _  ' Display Block
  2173.          63348, _  ' Display File
  2174.          63343, _  ' Wait # of seconds
  2175.          63350, _  ' Append to file
  2176.          63355, _  ' Stack
  2177.          63360, _  ' Case
  2178.          63370, _  ' Case Comparison
  2179.          63375, _  ' Macro execute
  2180.          63380, _  ' Macro Abort
  2181.          63383, _  ' Macro Echo on
  2182.          63385, _  ' Macro Echo off
  2183.          63336, _  ' Macro Comment
  2184.          63387, _  ' Turbo Key allowed
  2185.          63390     ' Form read
  2186.       GOTO 63398
  2187. 63338 A$ = X$
  2188. 63339 SUBROUTINE.PARAMETER = 4                                       ' KG062803
  2189.       CALL TPUT
  2190.       RETURN
  2191. 63340 X$ = SMART.TEXT$ + "END"  ' Print Block
  2192.       GOSUB 63395
  2193.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$
  2194.          GOSUB 63339
  2195.          CALL SKIPLINE (1)
  2196.          GOSUB 63395
  2197.       WEND
  2198.       GOTO 63336
  2199. 63343 CALL CHECKINT (X$)      ' Delay
  2200.       IF EC = 0 THEN _
  2201.          CALL DELAYIT (TESTED.INTEGER.VALUE)
  2202.       GOTO 63336
  2203. 63345 GOSUB 63338               ' Print Line
  2204.       GOTO 63336
  2205. 63347 GOSUB 63338
  2206.       CALL SKIPLINE (1)
  2207.       GOTO 63336
  2208. 63348 CALL TRIM (X$)            ' Print File
  2209.       CALL FINDITX (X$,7)                                            ' KG061001
  2210.       IF NOT OK THEN _
  2211.          GOTO 63336
  2212.       LINES.PRINTED = 1
  2213.       NO = FALSE                                                     ' KG071902
  2214.       NON.STOP = (NON.STOP OR PAGE.LENGTH < 1)                       ' KG060401
  2215. 63349 WHILE (NOT EOF(7) AND (NOT NO) AND (NON.STOP OR (LINES.PRINTED < PAGE.LENGTH)) AND (SUBROUTINE.PARAMETER > -1)) ' KG071904
  2216.          CALL READDIR (7,1)                                          ' KG061001
  2217.          GOSUB 63396                                                 ' KG060401
  2218.          SUBROUTINE.PARAMETER = 5
  2219.          CALL TPUT
  2220.       WEND
  2221.       DISTANT.TGET = 0
  2222.       IF SUBROUTINE.PARAMETER < 0 THEN _
  2223.          EXIT SUB
  2224.       IF EOF(7) OR NO THEN _                                         ' KG061001
  2225.          CLOSE 7 : _                                                 ' KG061001
  2226.          NO = FALSE : _                                              ' KG061001
  2227.          GOTO 63336
  2228.       DISTANT.TGET = 2
  2229.       CALL PAUSEEXIT
  2230.       EXIT SUB
  2231. 63350 EN$ = X$            ' Append to file
  2232.       X = INSTR(EN$," /FL")
  2233.       OVERSTRIKE = (X > 0)
  2234.       IF OVERSTRIKE THEN _
  2235.          EN$ = LEFT$(EN$,X-1) + RIGHT$(EN$,LEN(EN$)-X-3)
  2236.       CALL TRIM (EN$)
  2237.       CALL LOCKAPPND
  2238.       IF EC > 0 THEN _
  2239.          GOTO 63352
  2240.       GOSUB 63395
  2241.       X$ = SMART.TEXT$ + "END"
  2242.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$                       ' KG062803
  2243.          CALL PRNTWRKA (A$)
  2244.          GOSUB 63395
  2245.       WEND
  2246. 63352 CALL UNLKAPPND
  2247.       OVERSTRIKE = FALSE
  2248.       GOTO 63336
  2249. 63355 COMMPORT.STACK$ = COMMPORT.STACK$ + X$ + CARRIAGE.RETURN$ ' STack
  2250.       GOTO 63336
  2251. 63360 COMPARE.VAR = VAL(X$)
  2252.       CALL ALLCAPS (X$)                                              ' KG062901
  2253.       IF COMPARE.VAR < 1 OR COMPARE.VAR > MAX.WORK.VAR THEN _
  2254.          COMPARE.VAR = 0
  2255.       GOTO 63336
  2256. 63370 IF COMPARE.VAR = 0 THEN _     ' Compare Case
  2257.          GOTO 63336
  2258.       DF$ = GSR.ARA$(COMPARE.VAR)
  2259.       CALL ALLCAPS (DF$)
  2260.       CASE.EXECUTE = (X$ = DF$)
  2261.       GOTO 63336
  2262. 63375 CALL TRIM (X$)           ' Execute Macro
  2263.       CALL CHKMACRO (X$,X)
  2264.       GOTO 63336
  2265. 63380 MACRO.ACTIVE = FALSE     ' Abort Macro
  2266.       GOTO 63398
  2267. 63383 MACRO.ECHO = TRUE
  2268.       GOTO 63336
  2269. 63385 MACRO.ECHO = FALSE
  2270.       GOTO 63336
  2271. 63387 TURBO.KEY = -TURBO.KEY.USER   'TK Turbo Key
  2272.       GOTO 63336
  2273. 63390 B$ = A$
  2274.       B$(5) = ""
  2275.       B$(6) = ""
  2276.       Q = 1
  2277.       STORE.PARSE.AT = 1                                             ' KG083101
  2278.       CALL PARSEIT
  2279.       IF Q < 4 THEN _
  2280.          GOTO 63336
  2281.       X$ = SMART.TEXT$ + "END"
  2282.       GOSUB 63397                                                    ' KG081006
  2283.       MACRO.TEMPLATE$ = ""
  2284.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$
  2285.          MACRO.TEMPLATE$ = MACRO.TEMPLATE$ + A$ + CRLF$
  2286.          GOSUB 63397                                                 ' KG080302
  2287.       WEND
  2288.       X = VAL(B$(4))
  2289.       VAR.LEN = (B$(3) <> "/F")
  2290.       CALL FINDIT (B$(2))
  2291.       IF (X < 1) OR (NOT OK) OR (VAR.LEN AND X > MAX.WORK.VAR) THEN _
  2292.          MACRO.TEMPLATE$ = "" : _
  2293.          GOTO 63336
  2294. 63392 CALL FORMREAD (MACRO.TEMPLATE$,B$(2),NOT VAR.LEN,X,(B$(5) = "/FL"),(B$(6) = "/1"))
  2295.       IF MACRO.TEMPLATE$ <> "" THEN _
  2296.          EXIT SUB _
  2297.       ELSE GOTO 63336
  2298. 63395 GOSUB 63397                                                    ' KG080302
  2299.       GOSUB 63396                                                    ' KG080302
  2300.       RETURN                                                         ' KG080302
  2301. 63396 CALL SMARTTXT (A$,FALSE, OVERSTRIKE)
  2302.       CALL METAGSR (A$,OVERSTRIKE)
  2303.       RETURN
  2304. 63397 IF EOF(6) THEN _         ' Read next line in macro             ' KG080302
  2305.          MACRO.ACTIVE = FALSE _
  2306.       ELSE CALL READDIR (6,1) : _                                    ' KG080302
  2307.            MACRO.ACTIVE = (EC = 0)
  2308.       RETURN
  2309. 63398 END SUB    ' Not Macro command - pass to normal processing
  2310. 63400 ' $SUBTITLE: 'LOCKAPPND - prepares for file append'
  2311. ' $PAGE
  2312. '
  2313. '  NAME    -- LOCKAPPND
  2314. '
  2315. '  INPUTS  -- EN$            Name of file to append to
  2316. '
  2317. '  OUTPUTS -- none
  2318. '
  2319. '  PURPOSE -- Locks and opens file to append to
  2320. '
  2321.       SUB LOCKAPPND STATIC
  2322.       BX = &H4
  2323.       SUBROUTINE.PARAMETER = 9
  2324.       CALL FILELOCK
  2325.       EC = 0
  2326.       CALL OPENWRKA (EN$)
  2327.       END SUB
  2328. 63410 ' $SUBTITLE: 'UNLKAPPND - cleans up after file append'
  2329. ' $PAGE
  2330. '
  2331. '  NAME    -- UNLKAPPND
  2332. '
  2333. '  INPUTS  -- none
  2334. '
  2335. '  OUTPUTS -- none
  2336. '
  2337. '  PURPOSE -- Unlocks and close file appending to
  2338. '
  2339.       SUB UNLKAPPND STATIC
  2340.       BX = &H4
  2341.       SUBROUTINE.PARAMETER = 10
  2342.       CALL FILELOCK
  2343.       CLOSE 2
  2344.       END SUB
  2345. 63420 ' $SUBTITLE: 'FORMREAD - Reads from a file into a form'
  2346. ' $PAGE
  2347. '
  2348. '  NAME    -- FORMREAD
  2349. '
  2350. '  INPUTS  -- TEMPLATE$      Display formvoke shell with
  2351. '             FILNAME$       Data file to get values from
  2352. '             FIXED.LENGTH   Whether file is fixed length
  2353. '             DATA.VAR       # bytes data if fixed length; # fields
  2354. '                              if variable length
  2355. '             OVERSTRIKE     Whether typeover into form or insert
  2356. '             REC.PAUSE      Whether pause after every record displayed
  2357. '                               otherwise when screen fills
  2358. '  OUTPUTS -- (displays data base records)
  2359. '
  2360. '  PURPOSE -- Allows field oriented data base data to be displayed
  2361. '               in a human readable format by substituting field
  2362. '               data into template or form
  2363. '
  2364.       SUB FORMREAD (TEMPLATE$,FILNAME$,FIXED.LENGTH,DATA.VAR,OVERSTRIKE,REC.PAUSE) STATIC
  2365. 63422 IF EOF(2) OR NO OR (EC > 0) OR (SUBROUTINE.PARAMETER < 0) THEN _
  2366.          TEMPLATE$ = "" : _
  2367.          EXIT SUB
  2368.       IF FIXED.LENGTH THEN _
  2369.          CALL READDIR (2,1) : _
  2370.          GSR.ARA$(1) = A$ _
  2371.       ELSE CALL READPARMS (GSR.ARA$(),DATA.VAR,1)
  2372.       X$ = TEMPLATE$
  2373.       CALL SMARTTXT (X$,TRUE,OVERSTRIKE)
  2374.       CALL METAGSR (X$,OVERSTRIKE)
  2375.       CALL BUFASUNIT (X$)
  2376.       IF REC.PAUSE OR (PAGE.LENGTH > 0 AND (LINES.PRINTED >= PAGE.LENGTH-1)) THEN _
  2377.          CALL PAUSEEXIT : _
  2378.          EXIT SUB
  2379.       GOTO 63422
  2380.       END SUB
  2381. 63440 ' $SUBTITLE: 'BUFASUNIT - prints string with no pauses'
  2382. ' $PAGE
  2383. '
  2384. '  NAME    -- BUFASUNIT
  2385. '
  2386. '  INPUTS  -- STRNG$     String to print
  2387. '
  2388. '  OUTPUTS -- none
  2389. '
  2390. '  PURPOSE -- Prints string with embedded carriage returns.
  2391. '             Will never pause.  Used to print when can't call TGET
  2392. '
  2393.       SUB BUFASUNIT (STRNG$) STATIC
  2394.       L = LEN(STRNG$)
  2395.       IF L < 1 THEN _
  2396.          EXIT SUB
  2397.       START.BYTE = 1
  2398. 63450 CRAT = INSTR(START.BYTE,STRNG$,CARRIAGE.RETURN$)
  2399.       IF CRAT > 0 AND CRAT < L THEN _
  2400.          CR.FOUND = (MID$(STRNG$,CRAT + 1,1) = LINE.FEED$) _
  2401.       ELSE CR.FOUND = FALSE
  2402.       EOL.LEN = -2 * CR.FOUND
  2403.       IF CR.FOUND THEN _
  2404.          EOD = CRAT _
  2405.       ELSE EOD = L + 1
  2406.       NUM.BYTES = EOD - START.BYTE
  2407.       A$ = MID$(STRNG$,START.BYTE,NUM.BYTES)
  2408.       SUBROUTINE.PARAMETER = 4
  2409.       CALL TPUT
  2410.       CALL SKIPLINE (-(CR.FOUND))
  2411.       IF RET THEN _
  2412.          EXIT SUB
  2413.       START.BYTE = EOD + EOL.LEN
  2414.       IF START.BYTE <= L THEN _
  2415.          GOTO 63450
  2416.       END SUB
  2417. 63460 SUB MACROEXE (STRNG$) STATIC
  2418.       CALL TRIM (STRNG$)
  2419.       CALL FINDIT (STRNG$)
  2420.       IF NOT OK THEN _
  2421.          EXIT SUB
  2422.       COMMPORT.STACK$ = COMMPORT.STACK$ + STRNG$ + CARRIAGE.RETURN$
  2423.       CALL FDMACEXE
  2424.       END SUB
  2425. 63462 SUB FDMACEXE STATIC
  2426.       A$ = ""
  2427.       MACRO.ECHO = FALSE
  2428.       SUBROUTINE.PARAMETER = 4
  2429.       CALL TGET
  2430.       END SUB
  2431. 63465 SUB PAUSEEXIT STATIC
  2432.       ' CALL SKIPLINE (1)
  2433.       SUBROUTINE.PARAMETER = 4
  2434.       TURBO.KEY = -TURBO.KEY.USER
  2435.       A$ = MORE.PROMPT$ + ">" + MID$("? ! ",2*TURBO.KEY+1,2)
  2436.       FORCE.KEYBOARD = TRUE
  2437.       NO.ADVANCE = TRUE
  2438.       CALL TPUT
  2439.       LINES.PRINTED = 0
  2440.       B$ = ""                                                        ' KG060401
  2441.       END SUB
  2442. 63470 ' $SUBTITLE: 'CALLOPT - sub to set prompts based on user security'
  2443. ' $PAGE
  2444. '
  2445. '  NAME    -- CALLOPT
  2446. '
  2447. '  INPUTS  -- PARAMETER           MEANING
  2448. '             BEG.MAIN          POSITION START OF MAIN CMDS
  2449. '             BEG.FILE          POSITION START OF FILE CMDS
  2450. '             BEG.UTIL          POSITION START OF UTIL CMDS
  2451. '             BEG.LIBRARY       POSITION START OF LIBRARY CMDS
  2452. '
  2453. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2454. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2455. '             MAIN.OPTS$            MAIN OPTS USER CAN DO
  2456. '             FILE.OPTS$            FILE OPTS USER CAN DO
  2457. '             UTIL.OPTS$            UTIL OPTS USER CAN DO
  2458. '             LIBRARY.OPTS$         LIBRARY OPTS USER CAN DO
  2459. '
  2460. '  PURPOSE -- Sets command line display of what user can do by
  2461. '             section and display of what all user can do
  2462. '
  2463.       SUB CALLOPT STATIC
  2464.       FIRST = BEG.MAIN
  2465.       LAST = BEG.FILE - 1
  2466.       CALL SETOPTS (MAIN.OPTS$,INVALID.MAIN.OPTS$,FIRST,LAST)
  2467.       FIRST = BEG.FILE
  2468.       LAST = BEG.UTIL - 1
  2469.       CALL SETOPTS (FILE.OPTS$,INVALID.FILE.OPTS$,FIRST,LAST)
  2470.       FIRST = BEG.UTIL
  2471.       LAST = BEG.LIBRARY - 1
  2472.       CALL SETOPTS (UTIL.OPTS$,INVALID.UTIL.OPTS$,FIRST,LAST)
  2473.       FIRST = BEG.LIBRARY
  2474.       LAST = BEG.LIBRARY + 6
  2475.       CALL SETOPTS (LIBRARY.OPTS$,INVALID.LIBRARY.OPTS$,FIRST,LAST)
  2476.       FIRST = 50
  2477.       LAST = 56
  2478.       CALL SETOPTS (SYS.OPTS$,INVALID.SYS.OPTS$,FIRST,LAST)
  2479.       FIRST = 46
  2480.       LAST = 49
  2481.       CALL SETOPTS (GLOBAL.OPTS$,INVALID.GLOBAL.OPTS$,FIRST,LAST)
  2482.       IF LEN(SYS.OPTS$) > 0 THEN _
  2483.          SYSTEM.OPTS$ = "Sysop: " + _
  2484.                         SYS.OPTS$
  2485.       MAIN.OPTS$ = GLOBAL.OPTS$ + _
  2486.                    MAIN.OPTS$
  2487.       FILE.OPTS$ = GLOBAL.OPTS$ + _
  2488.                    FILE.OPTS$
  2489.       UTIL.OPTS$ = GLOBAL.OPTS$ + _
  2490.                    UTIL.OPTS$
  2491.       LIBRARY.OPTS$ = GLOBAL.OPTS$ + _
  2492.                       LIBRARY.OPTS$
  2493.       CALL SRTSTRNG (SYS.OPTS$)
  2494.       CALL SRTSTRNG (MAIN.OPTS$)
  2495.       MAIN.OPTS$ = MAIN.OPTS$ + _
  2496.                    SYS.OPTS$
  2497.       CALL SRTSTRNG (FILE.OPTS$)
  2498.       CALL SRTSTRNG (UTIL.OPTS$)
  2499.       CALL SRTSTRNG (LIBRARY.OPTS$)
  2500.       CALL INSCOMMA (MAIN.OPTS$)
  2501.       CALL INSCOMMA (FILE.OPTS$)
  2502.       CALL INSCOMMA (UTIL.OPTS$)
  2503.       CALL INSCOMMA (LIBRARY.OPTS$)
  2504.       DIR.PROMPT$ = "What directory(s) (" + _
  2505.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (USER.SECURITY.LEVEL => MIN.SEC.TO.VIEW) + 9)
  2506.       QUIT.PROMPT.EXPERT$ = "QUIT C,S, or to F,[M],U,@"
  2507.       QUIT.PROMPT.NOVICE$ = "QUIT C)onference, S)ession or to section " + _
  2508.                             "F)ile, [M]ain, U)til or @)Library"
  2509.       QUIT.LIST$ = "FMUS@C"
  2510.       IF USER.SECURITY.LEVEL < OPT.SEC(18) THEN _
  2511.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,23) : _
  2512.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,61) : _
  2513.          MID$(QUIT.LIST$,5) = " "
  2514.       IF USER.SECURITY.LEVEL < OPT.SEC(15) THEN _
  2515.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,22) + _
  2516.                                MID$(QUIT.PROMPT.EXPERT$,25) : _
  2517.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,56) + _
  2518.                                MID$(QUIT.PROMPT.NOVICE$,63) : _
  2519.          MID$(QUIT.LIST$,3,1) = " "
  2520.       IF USER.SECURITY.LEVEL < OPT.SEC(6) THEN _
  2521.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,16) + _
  2522.                                MID$(QUIT.PROMPT.EXPERT$,19) : _
  2523.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,41) + _
  2524.                                MID$(QUIT.PROMPT.NOVICE$,49) : _
  2525.          MID$(QUIT.LIST$,1,1) = " "
  2526.       CALL SETSECT
  2527.       END SUB
  2528. 63480 ' $SUBTITLE: 'NOPATH - detects whether string has path'
  2529. ' $PAGE
  2530. '
  2531. '  NAME    -- NOPATH
  2532. '
  2533. '  INPUTS  -- STRNG$     String to check
  2534. '
  2535. '  OUTPUTS -- HAS.NONE   True if has no path
  2536. '
  2537. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2538. '             be any
  2539. '
  2540.       SUB NOPATH (STRNG$,HAS.PATH) STATIC                            ' KG060801
  2541.       CALL BRKFNAME (STRNG$,DRVPATH$,PREFX$,EXT$,FALSE)              ' KG060801
  2542.       HAS.PATH = (DRVPATH$ <> "")                                    ' KG060801
  2543.       END SUB                                                        ' KG060801
  2544. 63490 ' $SUBTITLE: 'FINDIT - Determine whether file exists'
  2545. ' $PAGE
  2546. '
  2547. '  NAME    -- FINDIT
  2548. '
  2549. '  INPUTS  -- FILNAME$   File name to check
  2550. '
  2551. '  OUTPUTS -- OK         True if file exists.  Opened as #2 if does
  2552. '
  2553. '  PURPOSE -- Determine whether file exists and open as standard work
  2554. '             file if it does (#2)
  2555. '
  2556.       SUB FINDIT (FILNAME$) STATIC                                   ' KG061001
  2557.       CALL FINDITX (FILNAME$,2)                                      ' KG061001
  2558.       END SUB                                                        ' KG061001
  2559. 63495 ' $SUBTITLE: 'TIMEBACK - Give time back to the user'           ' KG082701
  2560. ' $PAGE
  2561. '
  2562. '  NAME    -- TIMEBACK
  2563. '
  2564. '  INPUTS  -- INDEX    = 1    Set start of time (begin give back)
  2565. '                      = 2    Give back time from defined start
  2566. '
  2567. '  OUTPUTS -- TIME.CREDIT!          Number of seconds to credit with
  2568. '             SECONDS.PER.SESSION!  Number of seconds in current session
  2569. '
  2570. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  2571. '
  2572.       SUB TIMEBACK (INDEX) STATIC                                    ' KG082701
  2573.       IF INDEX = 1 THEN _                                            ' KG082701
  2574.          CALL TIMEREMAIN (TIME.REMAINING!) : _                       ' KG082701
  2575.          Q! = TCA! : _                                               ' KG082701
  2576.          EXIT SUB                                                    ' KG082701
  2577.       CALL TIMEREMAIN (TIME.REMAINING!)                              ' KG082701
  2578.       X! = (TCA! - Q!)                                               ' KG082701
  2579.       TIME.CREDITS! = TIME.CREDITS! + X!                             ' KG082701
  2580.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!               ' KG082701
  2581.       END SUB                                                        ' KG082701
  2582. 63500 ' $SUBTITLE: 'CSPUSHPOP - Save/restore command stack'          ' KG082702
  2583. ' $PAGE
  2584. '
  2585. '  NAME    -- CSPUSHPOP
  2586. '
  2587. '  INPUTS  -- INDEX    = 1    Save command stack
  2588. '                      = 2    Restore command stack
  2589. '             ANS.INDEX
  2590. '             LAST.INDEX
  2591. '             B$()
  2592. '
  2593. '  OUTPUTS -- B$()                  Stacked commands
  2594. '             ANS.INDEX
  2595. '             LAST.INDEX
  2596. '
  2597. '  PURPOSE -- Save restore a command stack list when need to input
  2598. '             another list in middle of previous list processing
  2599. '
  2600.       SUB CSPUSHPOP (INDEX) STATIC                                   ' KG082702
  2601.       IF INDEX = 1 THEN _                                            ' KG082702
  2602.          ORIG.LAST.INDEX = LAST.INDEX : _  ' save                    ' KG082702
  2603.          ORIG.INDEX = ANS.INDEX : _                                  ' KG082702
  2604.          FOR I = 1 TO ORIG.LAST.INDEX : _                            ' KG082702
  2605.              A$(I) = B$(I) : _                                       ' KG082702
  2606.          NEXT : _                                                    ' KG082702
  2607.          EXIT SUB                                                    ' KG082702
  2608.       LAST.INDEX = ORIG.LAST.INDEX        ' restore                  ' KG082702
  2609.       ANS.INDEX = ORIG.INDEX                                         ' KG082702
  2610.       FOR I = 1 TO ORIG.LAST.INDEX                                   ' KG082702
  2611.          B$(I) = A$(I)                                               ' KG082702
  2612.       NEXT                                                           ' KG082702
  2613.       END SUB                                                        ' KG082702
  2614.