home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol084 / minirbbs.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  29.3 KB  |  1,447 lines
  1. 5 '    :---------->> MINIRBBS v. 2.7B  13/Jun/82 <<---------:
  2. 10 '   : MINIRBBBS                         :
  3. 15 '   : Message Module of RBBS version 2.2           :
  4. 20 '   : from Howard Moulton's original SJBBS (in Xitan    :
  5. 25 '   : Basic), converted to MBASIC and called RBBS or    :
  6. 30 '   : RIBBS by Bruce Ratoff, and extensively revised/   :
  7. 35 '   : expanded by Ron Fowler to become RBBS22.          :
  8. 40 '   :---------------------------------------------------:
  9. 45 '   : The Fowler version, RBBS22, was split into 2 mod- :
  10. 50 '   : ules, ENTERBBS and MINIRBBS, by Ben Bronson.      :
  11. 55 '   :---------------------------------------------------:
  12. 60 '   : Both were revised and given RBBS-compatible ver-  :
  13. 65 '   : sion nos. in 3/81 by Tim Nicholas, to incorporate :
  14. 70 '   : updates from his version 2.4 of RBBS              :
  15. 75 '   :---------------------------------------------------:
  16. 80 '   : Bill Earnest's bell-at-line-end routine was added :
  17. 85 '   : from RBBS 2.5 (see lines 26000+), and the 'G'     :
  18. 90 '   : command changed to be compatible with MINICBBS--  :
  19. 95 '   : Now both 'G' & 'C' return the caller to CP/M      :
  20. 100 '  : and don't sign him off.  The RBBS22/24 line       :
  21. 105 '  : numbering has been preserved to facilitate adding :
  22. 110 '  : further changes     --Ben Bronson, 26/3           :
  23. 115 '  :---------------------------------------------------:
  24. 120 '  :(a) Lines 760 & 770 removed to stop double-counting: 
  25. 125 '  : of callers. (b) Comment-leaving routine no longer :
  26. 130 '  : says "Thanks for the comment" when you didn't     :
  27. 135 '  : leave one.         --BB 2/4           :
  28. 145 '  :---------------------------------------------------:
  29. 150 '  * Note that most lines are numbered in conformity   *
  30. 155 '  * with the line numbers of versions 24, 25, & 24    *
  31. 160 '  * to make it easier to pull routines out and insert *
  32. 165 '  * them into customized programs.                    *
  33. 170 '  -----------------------------------------------------
  34. 175 '  - Features & ideas added to version 26 come from Bill
  35. 180 '  - Earnest, Jim C., Hank Szyszka, Chuck Witbeck, Earl
  36. 185 '  - Bockenfeld, Brian Kantor, & Skip Hansen
  37. 190 '  -----------------------------------------------------
  38. 195 '  
  39. 200 '  - experimental addition of WDE features @ lines
  40. 205 '    6240-8020 (?), 12000, 1020-1195, & 26000->  BB, 14/06
  41. 210 '
  42. 215 '  - Lines 1000- altered to accept P$ info.  M, U, & O
  43. 216 '  - now only usable by sysops or other P$<>RG or NW people.
  44. 217 '  - (ENTBBS27 puts P$ and DT$ into LASTCALR & passes them
  45. 218 '  - here as key to privileged user routines)
  46. 219 ' 
  47. 220 '  - Put in auto date entry routines from WDE 
  48. 221 '  - Read-SURVEY.BBS stuff from BK added, for privileged users only
  49. 222 '    
  50. 223 '  - Time stuff from HS inserted, 02/10/81.
  51. 224 '  - B command added; also minor cosmetic improvements. 14/10/81
  52. 225 '  - Howard Booker's fix at lines 6340 & 13030 added 31/10/81
  53. 226 '
  54. 227 '  -------------------------------------------------------------
  55. 228 '  MAGIC$ for SYSOP password added and Godbout System Support 1
  56. 229 '  clock routines added (as per ENTRBBS 2.7A). Special user function
  57. 230 '  prompt shortened to fit on screen. Version bumped to 2.7A
  58. 231 '  (for Australia) Bill Bolton, 01/Jun/82
  59. 232 '  Direct Port entry routines formally at 13000 removed as they
  60. 233 '  didn't work and even when corrected were no better than existing
  61. 234 '  INKEY$ code when running under BYE. In fact the INP instructions
  62. 235 '  effectively stopped the ^S from ever working! Added a "Mini" flag
  63. 236 '  so you can see where they came from (EXITRBBS noe puts "Exit").
  64. 237 '  15/Jun/82 Bill Bolton 
  65. 238 '  -------------------------------------------------------------
  66. 270 ' NOTE that time routine at 44000 (and the 'T' command) are set up
  67. 275 ' for a Godbout System Support 1 clock at ports 5A-5B. These will have
  68. 280 ' to be either deleted or changed to run with your system clock.
  69. 290 '
  70. 300    DEFINT A-Z
  71. 320    MODEMPORT = &H5C:
  72.     CONSOLEPORT = &H4:
  73.     
  74. 330    VERS$="(MINIRBBS vers 2.7D)"
  75. 340    DIM A$(19),M(200,2),H(6),HT(6),HD(6),TOD(5)
  76. 350    POKE 0,&HCD     'To disable ^C
  77. 360    INC=1:
  78.     ERS$=CHR$(8)+" "+CHR$(8)
  79. 370    ON ERROR GOTO 15000
  80. 375    MAGIC$="SUPER"    'The "MAGIC" sysop password
  81. 379 '
  82. 380 ' Signon functions...
  83. 381 '
  84. 400    MSGS=1:
  85.     CALLS=MSGS+1:
  86.     MNUM=CALLS+1
  87. 420    BK=0:
  88.     GOSUB 13020:
  89.     N=1:
  90.     A$="Software Tools/Sydney Remote CP/M Message Subsystem......":
  91.     N=0:
  92.     GOSUB 13020
  93. 460    BEL=-1:
  94.     XPR=0 'INITIAL BEL ON, NOT EXPERT
  95. 470    A$=VERS$:
  96.     GOSUB 13020
  97. 480    SAV$=""
  98. 500    INC=0
  99. 507 '
  100. 508 ' Get name, status & date from LASTCALR
  101. 509 '
  102. 510    OPEN "I",1,"A:LASTCALR":
  103.     INPUT #1,N$,O$,F$,DT$:
  104.     CLOSE
  105. 740    BK=0:
  106.     GOSUB 13020:
  107.     A$="Active # of msg's: ":
  108.     N=1:GOSUB 13020
  109. 745    OPEN "R",1,"A:COUNTERS",5:
  110.     FIELD#1,5 AS RR$:
  111.     GET#1,MSGS:
  112.     M=VAL(RR$)
  113. 750    A$=STR$(M):
  114.     GOSUB 13020
  115. 760    A$="You are caller # : ":
  116.     N=1:
  117.     GOSUB 13020:
  118.     GET#1,CALLS
  119. 770    CN=VAL(RR$)+INC:
  120.     A$=STR$(CN):
  121.     LSET RR$=A$:
  122.     GOSUB 13020:
  123.     PUT#1,CALLS
  124. 780    A$="Next msg # will be:":
  125.     N=1:
  126.     GOSUB 13020:
  127.     GET#1,MNUM:
  128.     U=VAL(RR$)
  129. 790    A$=STR$(U+1):
  130.     GOSUB 13020:
  131.     CLOSE:
  132.     GOSUB 13020
  133. 800 '
  134. 810 '  Look for messages for this caller
  135. 820 ' 
  136. 840    FT=1:
  137.     MX=0:
  138.     MZ=0:
  139.     IU=0:'FLAG FIRST TIME FOR PRINTING HEADING
  140. 850    OPEN "R",1,"A:SUMMARY",30:
  141.     RE=1:
  142.     FIELD#1,28 AS RR$
  143. 860    BK=0:
  144.     GET#1,RE:
  145.     IF EOF(1) THEN 
  146.         960
  147. 870    G=VAL(RR$):
  148.     MZ=MZ+1:
  149.     M(MZ,1)=G:
  150.     IF G=0 THEN 
  151.         950
  152. 880    IF IU=0 THEN 
  153.         IU=G
  154. 890    IF G>9998 THEN 
  155.         MZ=MZ-1:
  156.         GOTO 960
  157. 900    GET#1,RE+3:
  158.     GOSUB 16500:
  159.     IF INSTR(S$,N$)>0 AND INSTR(S$,O$)>0 THEN 
  160.         930
  161. 905    IF N$=MAGIC$ THEN 
  162.         N$="SYSOP"
  163. 910    IF N$<>"SYSOP" THEN 
  164.         950
  165. 920    IF INSTR(S$,"BILL")=0 THEN 
  166.         950
  167. 930    IF FT THEN 
  168.         A$="The following message(s) was/were left for you.":
  169.         GOSUB 13020
  170. 935    IF FT THEN 
  171.         A$="Please kill the ones that would not interest other callers.":
  172.         FT=0:
  173.         GOSUB 13020:
  174.         GOSUB 13020
  175. 940    A$=STR$(G):
  176.     N=1:
  177.     GOSUB 13020
  178. 950    GET#1,RE+5:
  179.     M(MZ,2)=VAL(RR$):
  180.     MX=MX+M(MZ,2)+6:
  181.     RE=RE+6:
  182.     GOTO 860
  183. 960    CLOSE:
  184.     GOSUB 13020:
  185.     GOSUB 13020
  186. 970    IF N$="SYSOP" THEN 
  187.         N$=MAGIC$
  188. 1000 '
  189. 1020 '    *** Main Command Acceptor/Dispatcher ***
  190. 1025 '
  191. 1030 '  (Lines 1176-1198 deal with privileged (SP) user functions &
  192. 1035 '   with keeping them away from non-privileged (RG & NW) users
  193. 1040 '
  194. 1060    A1$="Function":
  195.     IF NOT XPR THEN 
  196.         A1$=A1$+" [E,R,S,K,C,G,P,X,Q,T,B (or '?' if not known)]"
  197. 1080    A1$=A1$+"?":
  198.     GOSUB 13020:
  199.     C=1:
  200.     GOSUB 13260:
  201.     C=0
  202. 1100    IF B$="" THEN 
  203.         1180
  204. 1120    FF=INSTR("ER?SKCGPXQTB",B$):
  205.     GOSUB 1140:
  206.     GOTO 1000
  207. 1140    IF FF=0 THEN 
  208.         1175
  209. 1160    ON FF GOTO 6000,8000,5000,18060,11000,10000,2000,
  210.      17040,17000,18080,44000,22500
  211. 1175    IF N$+O$=MAGIC$ THEN 
  212.         1190
  213. 1176    IF F$<>"SP" THEN 
  214.         1200 
  215.     ELSE 
  216.         1190
  217. 1180    IF F$="RG" THEN 
  218.         1000   '<CR> brings all except SP back to main menu
  219. 1181    IF F$="NW" THEN 
  220.         1000   'ditto
  221. 1184    A1$="Functions for special users (O,M,U,Z) (or ? if not known)"
  222. 1186    A1$=A1$+"?":
  223.     GOSUB 13020:
  224.     C=1:
  225.     GOSUB 13260:
  226.     C=0
  227. 1188    IF B$="?" THEN 
  228.         GOSUB 23500:
  229.         GOTO 1000
  230. 1190    IF B$="O" THEN 
  231.         GOSUB 19000:
  232.         GOTO 1000
  233. 1192    IF B$="M" THEN 
  234.         GOSUB 27000:
  235.         GOTO 1000
  236. 1194    IF N$+O$=MAGIC$ THEN 
  237.         IF B$="9" THEN 
  238.             GOSUB 22000:
  239.             GOTO 1000
  240. 1196    IF B$="U" THEN 
  241.         GOSUB 12000:
  242.         GOTO 1000
  243. 1197    IF B$="Z" THEN 
  244.         GOSUB 23000
  245. 1198    GOTO 1000
  246. 1200    A$="I don't understand '"+B$+"', "+N$+".":
  247.     GOSUB 13020:
  248.     GOSUB 13020:
  249.     SAV$="":
  250.     RETURN
  251. 1201    GOTO 1000
  252. 2000 '
  253. 2020 '   Exit to CP/M
  254. 2220 ' 
  255. 2230    GOSUB 13020:
  256.     GOTO 10265
  257. 2237    GOSUB 44000
  258. 2240    GOSUB 13020:
  259.     POKE 4,0: 
  260.     A$="Now, back to CP/M...":
  261.     GOSUB 13020:
  262.     POKE 0,&HC3:
  263.     SYSTEM
  264. 3000 '
  265. 5000 '
  266. 5020 ' *** Display Menu of Functions ***
  267. 5040 '
  268. 5060    GOSUB 13020:
  269.     A$="Functions supported:":
  270.     GOSUB 13020:
  271.     IF BK THEN 
  272.         RETURN
  273. 5080    A$="S--> Scan messages      R--> Retrieve message":
  274.     GOSUB 13020:
  275.     IF BK THEN 
  276.         RETURN
  277. 5100    A$="E--> Enter message      K--> Kill message":
  278.     GOSUB 13020:
  279.     IF BK THEN 
  280.         RETURN
  281. 5120    A$="P--> Prompt (bel) togl  X--> eXpert user mode":
  282.     GOSUB 13020:
  283.     IF BK THEN 
  284.         RETURN
  285. 5140    A$="Q--> Quick summary      C--> Comment before exit to CP/M":
  286.     GOSUB 13020:
  287.     IF BK THEN 
  288.         RETURN
  289. 5160    A$="G--> Go direct to CP/M  T--> Time on system":
  290.     GOSUB 13020:
  291.     IF BK THEN 
  292.         RETURN
  293. 5180    A$="B--> Read bulletin on latest software":
  294. 5195    GOSUB 13020:
  295.     IF BK THEN 
  296.         RETURN
  297. 5200    GOSUB 13020:
  298.     A$="Commands may be strung together, separated by semicolons.":
  299.     GOSUB 13020
  300. 5205    A$="For example, 'R;123' retrieves message # 123.":
  301.     GOSUB 13020:
  302.     IF BK THEN 
  303.         RETURN
  304. 5210    A$="For forward sequential retrieval, use  '+' after Msg #.":
  305.     GOSUB 13020:
  306.     GOSUB 13020
  307. 5280    GOSUB 13020:
  308.     RETURN
  309. 6000 '  Date-entry routine for sysop (who may not pass thru ENTERBBS)
  310. 6010    IF N$<>MAGIC$ THEN 
  311.         6060
  312. 6015    GOSUB 13020:
  313.     A1$="Todays date (DD/MM/YY)?":
  314.     GOSUB 13020:
  315.     GOSUB 13260
  316. 6017    IF B$<>"" THEN
  317.         DT$=B$        'Defaults to current date unless over-ridden
  318. 6019 '
  319. 6020 '  Enter a new message
  320. 6040 '
  321. 6060    F=0:
  322.     GOSUB 13020:
  323.     OPEN "R",1,"A:COUNTERS",5:
  324.     A$="Msg # will be: ":
  325.     N=1:
  326.     GOSUB 13020:
  327.     FIELD#1,5 AS RR$:
  328.     GET#1,MNUM:
  329.     V=VAL(RR$)
  330. 6080    A$=STR$(V+1):
  331.     GOSUB 13020:
  332.     CLOSE
  333. 6089    '  ** Read date from LASTCALR
  334. 6100    GOSUB 13020:
  335.     A$="Today is "+DT$:
  336.     GOSUB 13020
  337. 6120    A1$="Who to (C/R for ALL)?":
  338.     GOSUB 13020:
  339.     C=1:
  340.     GOSUB 13260:
  341.     C=0:
  342.     IF B$="" THEN 
  343.         T$="ALL" 
  344.     ELSE 
  345.         T$=B$
  346. 6130 ' --- RBBS25 routine substituted here ---
  347. 6140    A1$="Subject (26 chars. max.):":
  348.     GOSUB 13020:
  349.     C=1:
  350.     GOSUB 13260:
  351.     C=0:
  352.     K$=B$
  353. 6150    IF LEN(K$)>30 THEN 
  354.         GOTO 6140
  355. 6160    A1$="Password?":
  356.     GOSUB 13020:
  357.     C=1:
  358.     GOSUB 13260:
  359.     C=0:
  360.     PW$=B$:
  361.     GOSUB 13020
  362. 6170    A1$="Type in up to 16 lines.  A bell sounds near the end of each.":
  363.     GOSUB 13020
  364. 6180    A1$="To edit or end, hit 2 C/Rs.  Don't use semicolons.":
  365.     GOSUB 13020:
  366.     GOSUB 13020:
  367.     F=0
  368. 6185    A1$=STRING$(62,45):
  369.     A1$="  |"+A1$+"|":
  370.     GOSUB 13020
  371. 6190    IF F=16 THEN 
  372.         A$="Msg full.":
  373.         GOSUB 13020:
  374.         GOTO 6240
  375. 6200    F=F+1:
  376.     A1$=STR$(F)+" ":
  377.     N=1:
  378.     GOSUB 13020:
  379.     GOSUB 13260:
  380.     IF B$="" THEN 
  381.         F=F-1:
  382.         GOTO 6240
  383. 6205    IF F=13 THEN 
  384.         PRINT "(3 lines left. . . .)"
  385. 6215    IF F=15 THEN 
  386.         PRINT "(Last line. . . .)"
  387. 6220    A$(F)=B$+" ":
  388.     GOTO 6190
  389. 6240    GOSUB 13020:
  390.     A1$="Choose: (L)ist, (E)dit, (A)bort, (C)ontinue, or (S)ave -- ":
  391.     IF XPR THEN 
  392.         A1$="L,E,A,C,S: ?"
  393. 6260    GOSUB 13020:
  394.     C=1:
  395.     GOSUB 13260:
  396.     C=0
  397. 6271 '  WDE edit routines begin here
  398. 6280    IF B$<>"L" THEN 
  399.         6360
  400. 6290    GOSUB 12220
  401. 6300    GOSUB 13020:
  402.     FOR L=1 TO F:
  403.         A$=STR$(L)+" "+A$(L)
  404. 6320        IF BK THEN 
  405.             6240 
  406.         ELSE 
  407.             GOSUB 13020:
  408.     NEXT L
  409. 6340    GOSUB 13020:
  410.     CLOSE:
  411.     GOTO 6240    'this CLOSE is from HB's FIX file
  412. 6360    IF B$="A" THEN 
  413.         A$="Aborted":
  414.         GOSUB 13020:
  415.         RETURN
  416. 6380    IF B$="C" AND FM=0 THEN 
  417.         6190
  418. 6400    IF B$="E" THEN 
  419.         6460    ' Note that EDIT only works after compiling
  420. 6420    IF B$="S" AND FM=0 THEN 
  421.         6560
  422. 6430    IF B$="S" AND FM=1 THEN 
  423.         27150
  424. 6440    GOTO 6240
  425. 6460    GOSUB 13020:
  426.     A1$="Line #?":
  427.     GOSUB 13020:
  428.     GOSUB 13260:
  429.     L=VAL(B$)
  430. 6480    IF L=0 OR L>F THEN 
  431.         6240 
  432.     ELSE 
  433.         A$="Was:":
  434.         GOSUB 13020:
  435.         A$=A$(L):
  436.         GOSUB 13020
  437. 6500    A1$="Enter new line":
  438.     IF NOT XPR THEN 
  439.         A1$=A1$+" (C/R for no change)"
  440. 6501    GOSUB 13020:
  441.     A1$="or  /oldstring/newstring/  to substitute"
  442. 6520    A1$=A1$+":":
  443.     GOSUB 13020:
  444.     GOSUB 13260
  445. 6521    IF LEFT$(B$,1)="/" THEN 
  446.         6541
  447. 6540    IF B$="" THEN 
  448.         6240 
  449.     ELSE 
  450.         A$(L)=B$+" ":
  451.         GOTO 6480
  452. 6541    IF RIGHT$(B$,1)="/" THEN 
  453.         B$=LEFT$(B$,LEN(B$)-1)
  454. 6542    B$=MID$(B$,2,99)
  455. 6543    FOR Q=LEN(B$) TO 1 STEP -1
  456. 6544        IF MID$(B$,Q,1)="/" THEN 
  457.             FROM$=LEFT$(B$,Q-1):
  458.             TO$=MID$(B$,Q+1,99)
  459. 6545    NEXT Q:
  460.     TEMP$=A$(L)
  461. 6546    FOR Q=1 TO LEN(TEMP$)-LEN(FROM$)+1
  462. 6547        IF MID$(TEMP$,Q,LEN(FROM$))=FROM$ THEN 
  463.             6550
  464. 6548    NEXT Q:
  465.     A1$="String not found!":
  466.     GOSUB 13020:
  467.     GOTO 6480
  468. 6550    A$(L)=""
  469. 6551    IF Q<>1 THEN 
  470.         A$(L)=LEFT$(TEMP$,Q-1)
  471. 6552    A$(L)=A$(L)+TO$+MID$(TEMP$,Q+LEN(FROM$),99):
  472.     GOTO 6480
  473. 6560 '
  474. 6580    IF PW$<>"" THEN 
  475.         PW$=";"+PW$
  476. 6600    A$="Updating summary file, ":
  477.     N=1:
  478.     GOSUB 13020
  479. 6620    OPEN "R",1,"A:SUMMARY",30:
  480.     RE=1:
  481.     FIELD#1,30 AS RR$:
  482.     RL=30
  483. 6640    RE=MZ*6+1:S$=STR$(V+1)+PW$:
  484.     GOSUB 16000:
  485.     PUT#1,RE
  486. 6660    RE=RE+1:
  487.     S$=DT$:
  488.     GOSUB 16000:
  489.     PUT#1,RE
  490. 6668    IF N$=MAGIC$ THEN 
  491.         N$="SYSOP"
  492. 6680    RE=RE+1:
  493.     S$=N$+" "+O$:
  494.     GOSUB 16000:
  495.     PUT#1,RE
  496. 6682    IF N$="SYSOP" THEN 
  497.         N$=MAGIC$
  498. 6700    RE=RE+1:
  499.     S$=T$:
  500.     GOSUB 16000:
  501.     PUT#1,RE
  502. 6720    RE=RE+1:
  503.     S$=K$:
  504.     GOSUB 16000:
  505.     PUT#1,RE
  506. 6740    RE=RE+1:
  507.     S$=STR$(F):
  508.     GOSUB 16000:
  509.     PUT#1,RE
  510. 6760    RE=RE+1:
  511.     S$=" 9999":
  512.     GOSUB 16000:
  513.     PUT#1,RE
  514. 6780    CLOSE#1
  515. 6800    A$="next msg #, ":
  516.     N=1:
  517.     GOSUB 13020:
  518.     OPEN "R",1,"A:COUNTERS",5:
  519.     FIELD#1,5 AS RR$
  520. 6820    GET#1,MNUM:
  521.     LSET RR$=STR$(VAL(RR$)+1):
  522.     PUT#1,MNUM
  523. 6840    A$="active msg's, ":
  524.     N=1:
  525.     GOSUB 13020
  526. 6860    GET#1,MSGS:
  527.     LSET RR$=STR$(VAL(RR$)+1):
  528.     PUT#1,MSGS:
  529.     CLOSE#1
  530. 6880    A$="and msg file.":
  531.     N=1:
  532.     GOSUB 13020:
  533.     OPEN "R",1,"A:MESSAGES",65:
  534.     RL=65
  535. 6900    FIELD#1,65 AS RR$
  536. 6920    RE=MX+1
  537. 6940    S$=STR$(V+1)+PW$:
  538.     GOSUB 16000:
  539.     PUT#1,RE
  540. 6960    RE=RE+1:
  541.     S$=DT$:
  542.     GOSUB 16000:
  543.     PUT#1,RE
  544. 6978    IF N$=MAGIC$ THEN 
  545.         N$="SYSOP"
  546. 6980    RE=RE+1:
  547.     S$=N$+" "+O$:
  548.     GOSUB 16000:
  549.     PUT#1,RE
  550. 6982    IF N$="SYSOP" THEN 
  551.         N$=MAGIC$
  552. 7000    RE=RE+1:
  553.     S$=T$:
  554.     GOSUB 16000:
  555.     PUT#1,RE
  556. 7020    RE=RE+1:
  557.     S$=K$:
  558.     GOSUB 16000:
  559.     PUT#1,RE
  560. 7040    RE=RE+1:
  561.     S$=STR$(F):
  562.     GOSUB 16000:
  563.     PUT#1,RE
  564. 7060    RE=RE+1
  565. 7080    FOR P=1 TO F:
  566.         S$=A$(P):
  567.         GOSUB 16000:
  568.         PUT#1,RE:
  569.         RE=RE+1:
  570.     NEXT P
  571. 7090    S$=" 9999":
  572.     GOSUB 16000:
  573.     PUT#1,RE:
  574.     CLOSE#1:
  575.     MX=MX+F+6:
  576.     MZ=MZ+1:
  577.     M(MZ,1)=V+1:
  578.     M(MZ,2)=F
  579. 7100    GOSUB 13020:
  580.     GOSUB 13020:
  581.     U=U+1:
  582.     RETURN
  583. 7200    RETURN
  584. 8000 '
  585. 8020 '  Retrieve a message
  586. 8040 '
  587. 8060    GOSUB 13020:
  588.     A1$="MSG # ("+STR$(IU)+" -"+STR$(U)+" )":
  589.     IF NOT XPR THEN 
  590.         A1$=A1$+" to retrieve (C/R to end)"
  591. 8080    A1$=A1$+"?":
  592.     GOSUB 13020:
  593.     GOSUB 13260:
  594.     GOSUB 13020
  595. 8100    IF LEN(B$)=0 THEN 
  596.         M=0 
  597.     ELSE 
  598.         M=VAL(B$)
  599. 8120    IF M<1 THEN 
  600.         GOSUB 13020:
  601.         RETURN
  602. 8140    IF M>U THEN 
  603.         A$="There aren't that many msg's, "+N$+".":
  604.         GOSUB 13020:
  605.         SAV$="":
  606.         GOTO 8060
  607. 8160    GOSUB 12220:
  608.     GOSUB 13020
  609. 8180    OPEN "R",1,"A:MESSAGES",65:
  610.     RE=1:
  611.     FIELD#1,64 AS RR$:
  612.     MI=0
  613. 8200    MI=MI+1:
  614.     IF (MI>MZ) OR BK THEN 
  615.         8540 
  616.     ELSE 
  617.         G=M(MI,1)
  618. 8220    IF G<M THEN 
  619.         RE=RE+M(MI,2)+6:
  620.         GOTO 8200
  621. 8240    IF G>M THEN 
  622.         8480
  623. 8260    GOSUB 19100:
  624.     IF OK THEN 
  625.         8280 
  626.     ELSE 
  627.         RE=RE+M(MI,2):
  628.         GOTO 8200
  629. 8280    RE=RE+1:
  630.     GET#1,RE:
  631.     GOSUB 16500:
  632.     D$=S$
  633. 8300    RE=RE+1:
  634.     GET#1,RE:
  635.     GOSUB 16500:
  636.     NO$=S$
  637. 8320    RE=RE+1:
  638.     GET#1,RE:
  639.     GOSUB 16500:
  640.     T$=S$
  641. 8340    RE=RE+1:
  642.     GET#1,RE:
  643.     GOSUB 16500:
  644.     GOSUB 19200:
  645.     K$=S$
  646. 8360    RE=RE+1:
  647.     GET#1,RE:
  648.     J=VAL(RR$):
  649.     GOSUB 13020
  650. 8380    A$="Msg # "+STR$(G)+"  Date entered: "+D$+"  From: "+NO$:
  651.     GOSUB 13020
  652. 8400    A$="To: "+T$+"  About: "+K$:
  653.     GOSUB 13020:
  654.     GOSUB 13020
  655. 8420    RE=RE+1:
  656.     FOR P=1 TO J:
  657.         GET#1,RE:
  658.         GOSUB 16500:
  659.         A$=S$:
  660.         GOSUB 13020
  661. 8440        IF BK THEN 
  662.             8540
  663. 8460        RE=RE+1:
  664.     NEXT P:
  665.     GOSUB 13020
  666. 8480    IF RIGHT$(B$,1)<>"+" THEN 
  667.         CLOSE:
  668.         GOTO 8020
  669. 8500    M=M+1:
  670.     MI=0:
  671.     RE=1
  672. 8520    IF M<=U AND NOT BK THEN 
  673.         8200
  674. 8540    CLOSE:
  675.     A$="** End of messages **":
  676.     GOSUB 13020:
  677.     GOSUB 13020:
  678.     D$="":
  679.     NO$="":
  680.     RETURN
  681. 9000 '
  682. 9020 '   Summarize messages
  683. 9040 '  (common code for S and Q commands)
  684. 9060 '
  685. 9080    GOSUB 13020
  686. 9090    A1$="Msg # ("+STR$(IU)+" -"+STR$(U)+" ) to start (C/R to end)?"
  687. 9095    GOSUB 13020:
  688.     C=1:
  689.     GOSUB 13260:
  690.     C=0:
  691.     GOSUB 13020 
  692. 9100    IF LEN(B$)=0 THEN 
  693.         M=0 
  694.     ELSE 
  695.         M=VAL(B$):
  696.         GOSUB 13220
  697. 9120    IP=INSTR(B$,","):
  698.     IF IP>0 THEN 
  699.         B$=MID$(B$,IP+1) 
  700.     ELSE 
  701.         ST=0:
  702.         GOTO 9220
  703. 9140    IF LEN(B$)<3 THEN 
  704.         RETURN
  705. 9160    IF MID$(B$,2,1)<>"=" THEN 
  706.         RETURN
  707. 9180    SV$=MID$(B$,3):
  708.     B$=LEFT$(B$,1):
  709.     ST=INSTR("FTS",B$)
  710. 9200    IF ST=0 THEN 
  711.         RETURN
  712. 9220    IF M<1 THEN 
  713.         RETURN
  714. 9240    IF M>U THEN 
  715.         A$="There ain't that many msg's, "+N$+".":
  716.         GOSUB 13020:
  717.         SAV$="":
  718.         RETURN
  719. 9260    IF NOT QU THEN 
  720.         GOSUB 12220:
  721.         GOSUB 13020
  722. 9280    OPEN "R",1,"A:SUMMARY",30:
  723.     RE=1:
  724.     FIELD #1,28 AS RR$
  725. 9300    GET #1,RE
  726. 9320    IF EOF(1) OR BK THEN 
  727.         9660 
  728.     ELSE 
  729.         G=VAL(RR$)
  730. 9340    IF G>9998 THEN 
  731.         9660
  732. 9360    IF G<M THEN 
  733.         RE=RE+6:
  734.         GOTO 9300
  735. 9380    GOSUB 19100:
  736.     IF OK THEN 
  737.         9400 
  738.     ELSE 
  739.         RE=RE+6:
  740.         GOTO 9300
  741. 9400    GET #1,RE+ST+1:
  742.     IF ST=0 THEN 
  743.         9420 
  744.     ELSE 
  745.         GOSUB 16500:
  746.         IF INSTR(S$,SV$)=0 THEN 
  747.             RE=RE+6:
  748.             GOTO 9300
  749. 9420    IF NOT QU THEN 
  750.         9500
  751. 9430 '
  752. 9440 '  Quick summary only
  753. 9450 '
  754. 9460    GET #1,RE+4:
  755.     GOSUB 16500:
  756.     GOSUB 19200:
  757.     A$=SPACE$(4-LEN(STR$(G)))+STR$(G)+" "+S$:
  758.     GOSUB 13020
  759. 9480    IF U=G OR BK THEN 
  760.         9660 
  761.     ELSE 
  762.         RE=RE+6:
  763.         GOTO 9300
  764. 9500 ' full summary
  765. 9501 ' Routine changed to print info on 2 instead of 4 lines --BB
  766. 9502 '
  767. 9520    RE=RE+1:
  768.     GET#1,RE:
  769.     GOSUB 16500:
  770.     D$=S$
  771. 9540    RE=RE+1:
  772.     GET#1,RE:
  773.     GOSUB 16500:
  774.     NO$=S$
  775. 9560    RE=RE+1:
  776.     GET#1,RE:
  777.     GOSUB 16500:
  778.     T$=S$
  779. 9580    RE=RE+1:
  780.     GET#1,RE:
  781.     GOSUB 16500:
  782.     GOSUB 19200:
  783.     K$=S$
  784. 9600    RE=RE+1:
  785.     GET#1,RE:
  786.     GOSUB 16500:
  787.     SZ$=S$
  788. 9610    ZS$=SZ$
  789. 9620    A$="#"+STR$(G)+" ="+ZS$+" lines, dated "+D$+"  From: "+NO$:
  790.     GOSUB 13020
  791. 9630    A$="To: "+T$+"   Re: "+K$:
  792.     GOSUB 13020
  793. 9640    GOSUB 13020:
  794.     IF U=G OR BK THEN 
  795.         9660 
  796.     ELSE 
  797.         RE=RE+1:
  798.         GOTO 9300
  799. 9660    GOSUB 13020:
  800.     A$="** End of summary **":
  801.     GOSUB 13020:
  802.     GOSUB 13020:
  803.     GOSUB 13020:
  804.     CLOSE:
  805.     RETURN
  806. 10000 '
  807. 10020 '  The goodbye routine (exit to CP/M is back at 2237)
  808. 10040 '
  809. 10055    GOSUB 13020:
  810.     GOSUB 13020
  811. 10060    A$="'Comments' are not readable by anyone except the SYSOP...":
  812.     GOSUB 13020
  813. 10065    A1$=" Want to leave any?":
  814.     GOSUB 13020:
  815.     C=1:
  816.     GOSUB 13260:
  817.     C=0
  818. 10070    IF LEFT$(B$,1)="N" THEN 
  819.         10260
  820. 10080    IF LEFT$(B$,1)<>"Y" THEN 
  821.         10060
  822. 10100    OPEN "R",1,"A:C"+CHR$(&HCF)+"MMENTS. "+CHR$(&HA0),65:
  823.     FIELD#1,65 AS RR$:
  824.     GET#1,1:
  825.     RE=VAL(RR$)+1:
  826.     RL=65
  827. 10120    IF RE=1 THEN 
  828.         RE=2
  829. 10140    S$="From: "+N$+" "+O$+" "+DT$+" (Mini)":
  830.     GOSUB 16000
  831. 10160    PUT#1,RE
  832. 10180    A$=" Enter comments, C/R to end:  (16 lines max)":
  833.     GOSUB 13020
  834. 10200    A$="-->":
  835.     N=1:
  836.     GOSUB 13020:
  837.     GOSUB 13260
  838. 10220    IF B$="" THEN 
  839.         10240 
  840.     ELSE 
  841.         RE=RE+1:
  842.         S$=B$:
  843.         RL=65:
  844.         GOSUB 16000:
  845.         PUT#1,RE:
  846.         GOTO 10200
  847. 10240    S$=STR$(RE):
  848.     RL=65:
  849.     GOSUB 16000:
  850.     PUT#1,1:
  851.     CLOSE
  852. 10250    GOSUB 13020
  853. 10251    A$="Many thanks for the comment, "+N$+".":
  854.     GOSUB 13020:
  855.     GOTO 10265
  856. 10260    GOSUB 13020:
  857.     A$=" No comment, then.":
  858.     GOSUB 13020
  859. 10265    GOSUB 13020:
  860.     A$=" Character count:  "+STR$(A)+" typed by system - "+STR$(D)+ " typed by you.":
  861.     GOSUB 13020
  862. 10280    GOSUB 13020:
  863.     GOSUB 13020:
  864.     GOTO 2237
  865. 10285 '  
  866. 10286 ' (note: to have the 'G' command disconnect rather than return the
  867. 10287 '  the user to CP/M, delete the above GOTO 2237 and restore the
  868. 10288 '  following lines, using the port number for your own modem)
  869. 10290 '  
  870. 10295 ' OUT 53,37  ' turn off DTR bit in modem control port.
  871. 10296 ' POKE &H0,&HC3:SYSTEM ' restore jump at BASE, RET to OS.
  872. 11000 '
  873. 11020 '  Routine to kill a message
  874. 11040 '
  875. 11060    GOSUB 13020:
  876.     A1$="Message # to kill?":
  877.     GOSUB 13020:
  878.     GOSUB 13260
  879. 11080    IF LEN(B$)=0 THEN 
  880.         M=0 
  881.     ELSE 
  882.         M=VAL(B$)
  883. 11100    IF M<1 THEN 
  884.         GOSUB 13020:
  885.         RETURN
  886. 11120    IF M>U THEN 
  887.         A$="There aren't that many msg's, "+N$+".":
  888.         GOSUB 13020:
  889.         SAV$="":
  890.         GOTO 11040
  891. 11140    A$="Scanning summary file....":
  892.     GOSUB 13020:
  893.     OPEN "R",1,"A:SUMMARY",30:
  894.     RE=1:
  895.     FIELD#1,30 AS RR$:
  896.     RL=30
  897. 11160    GET#1,RE
  898. 11180    IF EOF(1) THEN 
  899.         11520 
  900.     ELSE 
  901.         G=VAL(RR$)
  902. 11200    IF G>9998 THEN 
  903.         11520
  904. 11220    IF G<M THEN 
  905.         RE=RE+6:
  906.         GOTO 11160
  907. 11240    IF G>M THEN 
  908.         11520
  909. 11260    GOSUB 19100:
  910.     IF NOT OK THEN 
  911.         11520
  912. 11280    GOSUB 16500:
  913.     PW=INSTR(S$,";"):
  914.     PW$=""
  915. 11300    IF PW=0 OR N$+O$=MAGIC$ OR PERS THEN 
  916.         PERS=0:
  917.         GOTO 11340
  918. 11320    PW$=MID$(S$,PW+1)
  919. 11330    A1$="Password ?":
  920.     GOSUB 13020:
  921.     C=1:
  922.     GOSUB 13260:
  923.     C=0:
  924.     IF B$<>PW$ THEN 
  925.         A$="Incorrect.":
  926.         GOSUB 13020:
  927.         GOSUB 13020:
  928.         CLOSE:
  929.         RETURN
  930. 11340    S$=" 0"+":"+STR$(G):
  931.     GOSUB 16000:
  932.     PUT#1,RE:
  933.     CLOSE
  934. 11360    A$="Updating message file....":
  935.     GOSUB 13020
  936. 11380    OPEN "R",1,"A:MESSAGES",65:
  937.     RE=1:
  938.     FIELD#1,65 AS RR$:
  939.     MI=0
  940. 11400    MI=MI+1:
  941.     IF MI>MZ THEN 
  942.         11520 
  943.     ELSE 
  944.         G=M(MI,1)
  945. 11420    IF G<M THEN 
  946.         RE=RE+M(MI,2)+6:
  947.         GOTO 11400
  948. 11440    IF G=M THEN 
  949.         S$="0"+":"+STR$(G)+":"+N$+","+O$:
  950.         RL=65:
  951.         GOSUB 16000:
  952.         PUT#1,RE:
  953.         M(MI,1)=0
  954. 11460    CLOSE#1:
  955.     A$="Updating message count...":
  956.     GOSUB 13020
  957. 11480    OPEN "R",1,"A:COUNTERS",5:
  958.     FIELD#1,5 AS RR$:
  959.     GET#1,MSGS:
  960.     LSET RR$=STR$(VAL(RR$)-1):
  961.     PUT#1,MSGS:
  962.     CLOSE
  963. 11500    GOSUB 13020:
  964.     A$="Message killed.":
  965.     GOSUB 13020:
  966.     GOSUB 13020:
  967.     RETURN
  968. 11520    CLOSE:
  969.     A$="Message not found.":
  970.     GOSUB 13020:
  971.     GOSUB 13020:
  972.     RETURN
  973. 12000 '
  974. 12020    GOSUB 13020:
  975.     A$="The (U)SERS File (a sysops-only command)--":
  976.     GOSUB 13020
  977. 12040    A$="    [use ^K when you've seen enough]":
  978.     GOSUB 13020
  979. 12060    OPEN "R",1,"A:USERS",62:
  980.     FIELD#1,62 AS RR$:
  981.     FIELD#1,10 AS NN$
  982. 12070    GET#1,1:
  983.     NU=VAL(NN$)
  984. 12080    FOR I=NU+1 TO 2 STEP -1:
  985.         GET#1,I:
  986.         GOSUB 16500:
  987.         A$=S$:
  988.         GOSUB 13020
  989. 12100    IF BK THEN 
  990.         12140
  991. 12120    NEXT I
  992. 12140    CLOSE:
  993.     GOSUB 13020:
  994.     RETURN
  995. 12160 '
  996. 12180 '  Print control-char info
  997. 12200 '
  998. 12220    GOSUB 13020
  999. 13000    A$="Use Ctl-S to Pause, Repeated Ctl-K's to Abort."
  1000. 13020 '
  1001. 13040 '  Print string from A$ on console
  1002. 13060 '
  1003. 13080    IF SAV$<>"" AND A1$<>"" THEN 
  1004.         A1$="":RETURN
  1005. 13100    IF A1$<>"" THEN 
  1006.         A$=A1$:
  1007.         A1$=""
  1008. 13120    IF RIGHT$(A$,1)="?" OR N=1 THEN 
  1009.         PRINT A$;:
  1010.         PP$=A$:
  1011.         GOTO 13180
  1012. 13140    BI=ASC(INKEY$+" "):
  1013.     IF BI=19 THEN 
  1014.         BI=ASC(INPUT$(1))
  1015. 13160    IF BI=11 THEN 
  1016.         BK=-1:
  1017.         GOTO 13220 
  1018.     ELSE 
  1019.         PRINT A$
  1020. 13180    A=A+LEN(A$)
  1021. 13220    A$="":
  1022.     N=0
  1023. 13240    RETURN
  1024. 13260 '
  1025. 13280 '  Accept string into B$ from console 
  1026. 13300 '
  1027. 13320    IF BEL AND SAV$="" THEN 
  1028.         PRINT CHR$(7);
  1029. 13340    B$="":
  1030.     BK=0
  1031. 13360    IF SAV$="" THEN 
  1032.         GOSUB 26000
  1033. 13380    SP=INSTR(SAV$,";"):
  1034.     IF SP=0 THEN 
  1035.         B$=SAV$:
  1036.         SAV$="":
  1037.         GOTO 13420
  1038. 13400    B$=LEFT$(SAV$,SP-1):
  1039.     SAV$=MID$(SAV$,SP+1)
  1040. 13420    IF LEN(B$)=0 THEN 
  1041.         RETURN
  1042. 13440    IF C=0 THEN 
  1043.         13480
  1044. 13460    FOR ZZ=1 TO LEN(B$):
  1045.         MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):
  1046.     NEXT ZZ
  1047. 13480    IF LEN(B$)<63 THEN 
  1048.         13580
  1049. 13500    A$="Input line too long - would be truncated to:":
  1050.     GOSUB 13020
  1051. 13520    B$=LEFT$(B$,62):
  1052.     PRINT B$
  1053. 13540    LINE INPUT "Retype line (Y/N)?";QQ$:
  1054.     QQ$=LEFT$(QQ$,1)
  1055. 13560    IF QQ$="Y" OR QQ$="y" THEN 
  1056.         PRINT PP$;:
  1057.         SAV$="":
  1058.         GOTO 13260
  1059. 13580    D=D+LEN(B$):
  1060.     RETURN
  1061. 13600    RETURN
  1062. 15000 ' ***ON ERROR HANDLER***
  1063. 15020    IF ERL=18030 THEN 
  1064.         RESUME 18050
  1065. 15040    IF ERL=740 THEN 
  1066.         M=0:
  1067.         RESUME 750
  1068. 15050    IF ERL=760 THEN 
  1069.         C=0:
  1070.         RESUME 770
  1071. 15060    IF ERL=780 THEN 
  1072.         U=0:
  1073.         RESUME 790
  1074. 15070    IF ERL=6060 THEN 
  1075.         V=0:
  1076.         RESUME 6080
  1077. 15080    IF ERL=6800 THEN 
  1078.         C=0:
  1079.         RESUME 6820
  1080. 15090    IF ERL=6840 THEN 
  1081.         C=0:
  1082.         RESUME 6860
  1083. 15100    RESUME NEXT
  1084. 16000 '
  1085. 16010 ' Fill and store disk record
  1086. 16020 '
  1087. 16030    LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
  1088. 16040    RETURN
  1089. 16500 '
  1090. 16510 ' Unpack disk record
  1091. 16520 '
  1092. 16530    ZZ=LEN(RR$)-2
  1093. 16540    WHILE MID$(RR$,ZZ,1)=" "
  1094. 16550        ZZ=ZZ-1:
  1095.         IF ZZ=1 THEN 
  1096.             16570
  1097. 16560    WEND
  1098. 16570    S$=LEFT$(RR$,ZZ)
  1099. 16580    IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
  1100. 16590    RETURN
  1101. 17000 '
  1102. 17010 ' *** Toggle EXPERT USER mode
  1103. 17020 '
  1104. 17030    XPR=NOT XPR:
  1105.     RETURN
  1106. 17040 '
  1107. 17050 ' *** Toggle BELL prompt
  1108. 17060 '
  1109. 17070    BEL=NOT BEL:
  1110.     RETURN
  1111. 18000 '
  1112. 18010 ' Subroutine to print a file
  1113. 18020 '
  1114. 18030    OPEN "I",1,"A:"+FIL$:
  1115.     BK=0
  1116. 18040    IF EOF(1) OR BK THEN 
  1117.         18050 
  1118.     ELSE 
  1119.         LINE INPUT #1,A$:
  1120.         GOSUB 13020:
  1121.         GOTO 18040
  1122. 18050    CLOSE #1:
  1123.     RETURN
  1124. 18060 ' FULL SUMMARY
  1125. 18070    QU=0:
  1126.     GOSUB 9000:
  1127.     RETURN
  1128. 18080 ' QUICK SUMMARY
  1129. 18090    QU=-1:
  1130.     GOSUB 9000:
  1131.     RETURN
  1132. 19000    GOSUB 13020:
  1133.     A$="The (O)THER CALLERS File (a sysops-only command)--":
  1134.     GOSUB 13020
  1135. 19010    GOSUB 13020
  1136. 19020    IF F$="RG" THEN 
  1137.         1200    ' IF NOT SYSOP, SAY "I DON'T UNDERSTAND".
  1138. 19030    OPEN "R",1,"A:CALLERS",60:
  1139.     FIELD #1,60 AS RR$:
  1140.     GET #1,1:
  1141.     SIZ=VAL(RR$)
  1142. 19040    CA=CN
  1143. 19050    FOR CNT=SIZ+1 TO 2 STEP -1
  1144. 19060        GET #1,CNT:
  1145.         GOSUB 16500:
  1146.         A$=SPACE$(5-LEN(STR$(CA)))+STR$(CA)+" "+S$:
  1147.         GOSUB 13020:
  1148.         IF BK THEN 
  1149.             19090
  1150. 19070    CA=CA-1
  1151. 19080    NEXT CNT
  1152. 19090    CLOSE:
  1153.     A$= "END OF CALLERS.":
  1154.     GOSUB 13020:
  1155.     GOSUB 13020:
  1156.     RETURN
  1157. 19100 ' TEST FOR PERSONAL MESSAGES
  1158. 19110    PERS=0:
  1159.     OK=-1:
  1160.     GET #1,RE:
  1161.     IF INSTR(RR$,";*")=0 THEN 
  1162.         19160
  1163. 19120    PERS=-1
  1164. 19130    IF N$+O$=MAGIC$ THEN 
  1165.         19160
  1166. 19140    GET #1,RE+3:
  1167.     GOSUB 19170:
  1168.     IF OK THEN 
  1169.         19160
  1170. 19150    GET #1,RE+2:
  1171.     GOSUB 19170
  1172. 19160    RETURN
  1173. 19170 ' TEST 'FROM' OR 'TO' FIELD FOR USER'S NAME
  1174. 19180    IF INSTR(RR$,N$)>0 AND INSTR(RR$,O$)>0 THEN 
  1175.         OK=-1 
  1176.     ELSE 
  1177.         OK=0
  1178. 19190    RETURN
  1179. 19200    IF PERS THEN 
  1180.         S$="("+S$:
  1181.         S$=S$+")":
  1182.         PERS=0
  1183. 19210    RETURN
  1184. 22000 '  Subroutine to print COMMENTS file (for sysop only)
  1185. 22020 '
  1186. 22030    OPEN "I",1,"A:COMMENTS":
  1187.     BK=0
  1188. 22040    IF EOF(1) OR BK THEN 
  1189.         22050 
  1190.     ELSE 
  1191.         LINE INPUT #1,A$:
  1192.         GOSUB 13020:
  1193.         GOTO 22040
  1194. 22050    CLOSE #1:
  1195.     A$="End of comments.":
  1196.     GOSUB 13020:
  1197.     GOSUB 13020:
  1198.     RETURN
  1199. 22500 '  Subroutine to print BULLETIN (new programs) file...
  1200. 22510 '
  1201. 22520    OPEN "I",1,"A:BULLETIN":
  1202.     BK=0
  1203. 22540    IF EOF(1) OR BK THEN 
  1204.         22560 
  1205.     ELSE 
  1206.         LINE INPUT #1,A$:
  1207.         GOSUB 13020:
  1208.         GOTO 22540
  1209. 22560    CLOSE #1:
  1210.     A$="End of New Program Bulletin":
  1211.     GOSUB 13020:
  1212.     GOSUB 13020:
  1213.     RETURN
  1214. 23000 '  Subroutine to print SURVEY.BBS file for special users
  1215. 23010 '
  1216. 23030    OPEN "I",1,"A:SURVEY.BBS":
  1217.     BK=0
  1218. 23040    IF EOF(1) OR BK THEN 
  1219.         23050 
  1220.     ELSE 
  1221.         LINE INPUT #1,A$:
  1222.         GOSUB 13020:
  1223.         GOTO 23040
  1224. 23050    CLOSE #1:
  1225.     A$="End of the survey data currently on this disk.":
  1226.     GOSUB 13020:
  1227.     GOSUB 13020:
  1228.     RETURN
  1229. 23060 '
  1230. 23500 '  Sub. for special user command menu
  1231. 23510    GOSUB 13020:
  1232.     A$="Special Users can also use these commands:":
  1233.     GOSUB 13020:
  1234.     GOSUB 13020
  1235. 23520    A$=" M = alter old MESSAGE     O = view OTHER CALLERS file":
  1236.     GOSUB 13020
  1237. 23540    A$=" U = view USERS file       Z = view USER SURVEY file":
  1238.     GOSUB 13020:
  1239.     GOSUB 13020
  1240. 23560    A$=" [note that USERS is very long.  Be prepared to use":
  1241.     GOSUB 13020
  1242. 23580    A$="  ^K to exit from it.  And M will not allow changes":
  1243.     GOSUB 13020
  1244. 23600    A$="  that mean adding extra lines to old messages...]":
  1245.     GOSUB 13020:
  1246.     GOSUB 13020
  1247. 23620    RETURN
  1248. 25999 '  Subroutine to replace LPRINT & make line-end bell
  1249. 26000    CHC=0:
  1250.      SAV$=""
  1251. 26010    NCH=ASC(INPUT$(1))
  1252. 26020    IF NCH=127 THEN 
  1253.         26080
  1254. 26030    IF NCH<32 THEN 
  1255.         26110
  1256. 26040    IF CHC>=63 THEN 
  1257.         26010
  1258. 26050    SAV$=SAV$+CHR$(NCH):
  1259.     CHC=CHC+1:
  1260.     PRINT CHR$(NCH);
  1261. 26060    IF CHC=55 THEN 
  1262.         PRINT CHR$(7);
  1263. 26070    GOTO 26010
  1264. 26080    IF CHC=0 THEN 
  1265.         26010 
  1266.     ELSE 
  1267.         PRINT RIGHT$(SAV$,1);:
  1268.         GOTO 26100
  1269. 26090    IF CHC=0 THEN 
  1270.         26010 
  1271.     ELSE 
  1272.         PRINT ERS$;
  1273. 26100    CHC=CHC-1:
  1274.     SAV$=LEFT$(SAV$,CHC):
  1275.     GOTO 26010
  1276. 26110    IF NCH=8 THEN 
  1277.         26090
  1278. 26120    IF NCH=13 THEN 
  1279.         PRINT:
  1280.         RETURN
  1281. 26130    IF NCH=21 THEN 
  1282.         PRINT " #":
  1283.         GOTO 26000
  1284. 26140    IF NCH<>24 OR CHC=0 THEN 
  1285.         26010
  1286. 26150    FOR BCC=1 TO CHC:
  1287.         PRINT ERS$;:
  1288.     NEXT BCC:
  1289.     GOTO 26000
  1290. 27000    GOSUB 13020:
  1291.     A$="Old message-modifying function, currently available only for sysops.":
  1292.     GOSUB 13020
  1293. 27005    GOSUB 13020:
  1294.     A1$="MSG # TO MODIFY?":
  1295.     GOSUB 13020:
  1296.     GOSUB 13260:
  1297.     GOSUB 13020
  1298. 27007    IF B$="" THEN 
  1299.         1000
  1300. 27010    IF LEN(B$)=0 THEN 
  1301.         M=0 
  1302.     ELSE 
  1303.         M=VAL(B$)
  1304. 27020    IF M<1 THEN 
  1305.         GOSUB 13020:
  1306.         RETURN
  1307. 27030    IF M>U THEN 
  1308.         A$="There aren't that many msgs, "+N$+".":
  1309.         GOSUB 13020:
  1310.         SAV$="":
  1311.         GOTO 27000
  1312. 27040    GOSUB 13020
  1313. 27050    OPEN "R",1,"A:MESSAGES",65:
  1314.     RE=1:
  1315.     FIELD#1,64 AS RR$:
  1316.     MI=0
  1317. 27060    MI=MI+1:
  1318.     IF (MI>MZ) OR BK THEN 
  1319.         GOTO 27090 
  1320.     ELSE 
  1321.         G=M(MI,1)
  1322. 27070    IF G<M THEN 
  1323.         RE=RE+M(MI,2)+6:
  1324.         GOTO 27060
  1325. 27080    IF G=M THEN 
  1326.         27100
  1327. 27090    CLOSE:
  1328.     RETURN
  1329. 27100    GOSUB 19100:
  1330.     IF NOT OK THEN 
  1331.         RE=RE+M(MI,2):
  1332.         GOTO 27060
  1333. 27101    GOSUB 16500:
  1334.     PW=INSTR(S$,";"):
  1335.     PW$=""
  1336. 27102    IF PW=0 OR N$+O$="SYSOP" OR PERS THEN 
  1337.         PERS=0:
  1338.         GOTO 27110
  1339. 27103    PW$=MID$(S$,PW+1):
  1340.     A1$="Password ?":
  1341.     GOSUB 13020:
  1342.     C=1:
  1343.     GOSUB 13260:
  1344.     C=0
  1345. 27104    IF B$<>PW$ THEN 
  1346.         A$="Incorrect.":
  1347.         GOSUB 13020:
  1348.         CLOSE:
  1349.         RETURN
  1350. 27110    RE=RE+5:
  1351.     GET#1,RE:
  1352.     F=VAL(RR$):
  1353.     RE=RE+1:
  1354.     ORE=RE:
  1355.     LF=F
  1356. 27120    FOR QP = 1 TO LF
  1357. 27125        GET#1,RE:
  1358.         GOSUB 16500:
  1359.         A$(QP)=S$:
  1360.         RE=RE+1:
  1361.     NEXT QP
  1362. 27130    FM=1:
  1363.     GOTO 6290
  1364. 27150    OPEN "R",1,"A:MESSAGES",65:
  1365.     RL=65:
  1366.     FIELD#1,65 AS RR$:
  1367.     RE=ORE
  1368. 27160    FOR QP = 1 TO LF
  1369. 27165        S$=A$(QP):
  1370.         GOSUB 16000:
  1371.         PUT#1,RE:
  1372.         RE=RE+1:
  1373.     NEXT QP
  1374. 27170    CLOSE:
  1375.     FM=0:
  1376.     RETURN
  1377. 44000 '
  1378. 44002 'CLOCK ROUTINES
  1379. 44005 '
  1380. 44010    BASEPORT = &H50
  1381. 44020    CMDPORT = BASEPORT + 10
  1382. 44030    DATAPORT = CMDPORT + 1
  1383. 44040    FOR DIGIT = 5 TO 0 STEP -1
  1384. 44050        OUT CMDPORT,(&H10 + DIGIT)
  1385. 44060        TOD(DIGIT) = INP(DATAPORT)
  1386. 44070        IF DIGIT = 5 THEN TOD(DIGIT) = TOD(DIGIT) AND 3
  1387. 44080    NEXT DIGIT
  1388. 44090    H(1) = TOD(5)
  1389. 44100    H(2) = TOD(4)
  1390. 44110    H(3) = TOD(3)
  1391. 44120    H(4) = TOD(2)
  1392. 44130    H(5) = TOD(1)
  1393. 44140    H(6) = TOD(0)
  1394. 44260 '
  1395. 44270    PRINT:
  1396.     PRINT "The time now is (Hrs:Mins:Secs).... ";
  1397. 44280    TF$="#"
  1398. 44290    FOR I=1 TO 6
  1399. 44300        PRINT USING TF$;H(I);
  1400. 44310        IF I=2 THEN 
  1401.             PRINT ":";
  1402. 44320        IF I=4 THEN 
  1403.             PRINT ":";
  1404. 44330    NEXT I
  1405. 44340    PRINT
  1406. 44700 '  Now get hh/mm/ss stored by enterbbs
  1407. 44710    HT(1)=PEEK(74):
  1408.     HT(2)=PEEK(75):
  1409.     HT(3)=PEEK(76)
  1410. 44720    HT(4)=PEEK(77):
  1411.     HT(5)=PEEK(78):
  1412.     HT(6)=PEEK(79)
  1413. 44730 '  And calculate the difference...
  1414. 44740    IF H(6)<HT(6) THEN 
  1415.         H(6)=H(6)+10:
  1416.         H(5)=H(5)-1
  1417. 44750    IF H(5)<HT(5) THEN 
  1418.         H(5)=H(5)+6:
  1419.         H(4)=H(4)-1
  1420. 44760    IF H(4)<HT(4) THEN 
  1421.         H(4)=H(4)+10:
  1422.         H(3)=H(3)-1
  1423. 44770    IF H(3)<HT(3) THEN 
  1424.         H(3)=H(3)+6:
  1425.         H(2)=H(2)-1
  1426. 44780    IF H(2)<HT(2) THEN 
  1427.         H(2)=H(2)+10:
  1428.         H(1)=H(1)-1
  1429. 44790    HD(6)=H(6)-HT(6):
  1430.     HD(5)=H(5)-HT(5):
  1431.     HD(4)=H(4)-HT(4)
  1432. 44800    HD(3)=H(3)-HT(3):
  1433.     HD(2)=H(2)-HT(2):
  1434.     HD(1)=H(1)-HT(1)
  1435. 44810    PRINT "You've been on the system for...... ";
  1436. 44820    TF$="#"
  1437. 44830    FOR I=1 TO 6
  1438. 44840        PRINT USING TF$;HD(I);
  1439. 44850        IF I=2 THEN 
  1440.             PRINT ":";
  1441. 45860        IF I=4 THEN 
  1442.             PRINT ":";
  1443. 45870    NEXT I
  1444. 45880    PRINT:
  1445.     PRINT
  1446. 45890    RETURN
  1447.