home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / bbsing / bbs / qrun410.lbr / QRUN410.BZS / QRUN410.BAS
BASIC Source File  |  1989-11-02  |  93KB  |  3,387 lines
  1.         'QRUN.BAS
  2.  
  3.         'Copyright (c) 1989.  All rights reserved.
  4.  
  5.         'Main module of QBBS bulletin board system, written by
  6.         'Larry Davis, Glendale CA, and updated jointly with Chris McEwen,
  7.         'S. Plainfield NJ.
  8.  
  9.         'You are asked to submit updates and improvements to the QBBS
  10.         'bulletin board system to Larry Davis on the Glendale Litera,
  11.         'at (818) 956-6164, or to Chris McEwen on Socrates Z-Node #32,
  12.         'at (201) 754-9067.
  13.  
  14.         'Compile command (where vvvv = version):
  15.         'BASCOM =QRUNvvvv/O/E/C/Z
  16.  
  17.         'Link Commmand:
  18.         'LD80 QRUNvvvv,QREL/S,OBSLIB/S,QRUNvvvv/N/E             'for LD80
  19.         'SLRNK QRUNvvvv/N,/A:100,QRUNvvvv,QREL/S,OBSLIB/S,/E    'for SLRNK
  20.  
  21.         'Search for ">>>>>>>>>>>>>>>>." and replace with
  22.         'the name of your RCPM.
  23.  
  24.         'To print a formatted hardcopy of this program, use a global
  25.         'search and replace (^QA) to remove the apostrophe before
  26.         'the following two 'dot' commands, and all page break commands.
  27.  
  28. '.he                             QRUN Version 4.10
  29. '.fo                                  Page -#-
  30.  
  31.         'Please refer to QRUNvvvv.HIS for history notes.
  32.  
  33. '.pa
  34.         '** Establish basic options
  35.  
  36.         'Variables:
  37.         ' VERS$        = version number
  38.  
  39.         OPTION BASE 1
  40.         POKE 0,&HCD
  41.         DEFINT A-Z
  42.         WIDTH 130
  43.  
  44.  
  45.         '** Variable definitions:
  46.  
  47.         DIM  MFILE$(6),_                        '6 message files
  48.              MSGNDX(3)
  49.  
  50.         ABORT$="Aborted"
  51.         BEL$=CHR$(7)                            'bell
  52.         DRIVE$="A:"                             'bbs data drive assignment
  53.         CRLF$=CHR$(13)+CHR$(10)                 'carriage return, line feed
  54.         ERS$=CHR$(8)+" "+CHR$(8)                'eraseable backspace
  55.         HEADER$=_
  56.            " MSG# |  DATE    | FROM        | TO          | SUBJECT (LINES)"
  57.         MSG$="essage"
  58.         CMSG$="M"+MSG$
  59.         MSG$="m"+MSG$
  60.         MODE$=" mode"
  61.         M1$="1"
  62.         NOSUCH$="Line does not exist"
  63.         SUBJ$="Subject"
  64.         VERS$="QRUN v4.10"+CRLF$+"(c) 1989, L. Davis & C. McEwen"
  65.         CAPS=1
  66.         DASHFILE = 0                            'for FOR/QNEWS pagination
  67.         DUP=-1                                  'duplex on
  68.         FIRSTPAGE = -1                          'for FOR/QNEWS pagination
  69.         FL = 0
  70.         INLINE = -1
  71.         PAG=-1
  72.         PAGLEN = 23                             'page length before (more?)
  73.  
  74.         'Enter -1 if you do allow 'upload mode' of message entry,
  75.         'and    0 if you do not
  76.         UPMODE= -1
  77.  
  78. '.pa
  79.         '** Check if BYE is active
  80.         %INCLUDE QBYCK.INC
  81.  
  82.         '   move to user area 0
  83.         CMD = 32
  84.         DAT = 0
  85.         RES = 0
  86.         CALL BDOS(CMD,DAT,RES)                  'change user areas
  87.  
  88.         '** Check for CP/M command line options
  89.  
  90.         'Variables:
  91.         ' A$           = temporary string
  92.         ' CC           = CPM comment flag
  93.         ' M1$          = message base number
  94.         ' MFG          =
  95.  
  96.         IF PEEK(&H80)=0_
  97.              THEN 100
  98.  
  99.         A$=CHR$(PEEK(&H82))
  100.  
  101.         IF A$="C"_                              'CPM comment flag
  102.              THEN CC=-1:_
  103.                   GOTO 180
  104.  
  105.         IF A$>"0" AND A$<"7"_                   'direct return to a
  106.              THEN MFG=-1:_                      'particular message base.
  107.                   M1$=A$
  108.  
  109.  
  110.         '** Clear screen on login
  111.  
  112.         'Variables:
  113.         ' NULLS        = number of nulls
  114.         ' I            = loop counter
  115.  
  116. 100     POKE 4,0
  117.         POKE NULLS,0
  118.         PRINT
  119.         PRINT STRING$(23,10)                    'print 23 line feeds
  120.         POKE NULLS,PEEK(&H3C)
  121.  
  122.  
  123. '.pa
  124.         '** Get message file names
  125.  
  126.         'Variables:
  127.         ' MFILE$(n)    = array of message base names
  128.         ' MFILE$       = name of current message base
  129.         ' DRIVE$       = drive assignment of bbs data files
  130.         ' I            = loop counter
  131.  
  132.         MFILE$(1)="General Topics"
  133.         MFILE$=MFILE$(1)
  134.         OPEN "I",1,DRIVE$+"MFILE"
  135.         FOR I = 2 TO 6
  136.              INPUT#1,MFILE$(I)
  137.         NEXT I
  138.         CLOSE 1
  139.  
  140.  
  141.         '** Get D/U
  142.  
  143.         'Variables:
  144.         ' DRIVE$       = drive assignment of bbs data files
  145.         ' USER$        = user number of bbs data files
  146.         ' CPMPASS$     = password to enter CPM mode
  147.         ' CFIL$        = name of command file
  148.         ' TZA$         = time zone
  149.         ' DAT          = BDOS command data
  150.         ' CMD          = BDOS command
  151.  
  152. 180     OPEN "I",1,DRIVE$+"PWDS"
  153.         INPUT #1,DRIVE$,USER$,CPMPASS$,CFIL$,TZA$
  154.         CLOSE 1
  155.  
  156.        '   move to data user area
  157.         CMD = 32
  158.         DAT=VAL(USER$)
  159.         RES = 0
  160.         CALL BDOS(CMD,DAT,RES)                  'change user areas
  161.  
  162. '.pa
  163.         '** Open LCALLER and get user parameters
  164.  
  165.         'Variables
  166.         ' A$           =
  167.         ' LON$         = last on date
  168.         ' N$           = user's first name
  169.         ' O$           = user's last name
  170.         ' PW$          = user's password
  171.         ' ST$          = user's state
  172.         ' UF$          = user's access level
  173.         ' UP$          = user's parameters
  174.         ' UR$          =
  175.  
  176.         A$="I"
  177.         GOSUB 30015                             'open lcaller file
  178.         INPUT #1,N$,O$,UF$,UR$,PW$,ST$,UP$,LON$
  179.         CLOSE 1
  180.  
  181.         '** Check for sysop, set flag and welcome user
  182.  
  183.         'Variables:
  184.         ' HOMEBASE$    = User's home message base
  185.         ' CC           = CPM comment
  186.         ' M1$          = message base number
  187.         ' MFG          =
  188.         ' N$           = user's first name
  189.         ' O$           = user's last name
  190.         ' UN$          =
  191.         ' UO$          =
  192.         ' UP$          = user's parameters
  193.         ' UR           =
  194.         ' UR$          =
  195.  
  196.         GOSUB 30060                             'check for sysop, set flag
  197.         UR=VAL(UR$)
  198.  
  199.         IF CC_
  200.              THEN 280
  201.  
  202.         UN$=N$
  203.         UO$=O$
  204.  
  205.         'Enter the name of your RCPM here:
  206.         PRINT CRLF$;"Hello, ";N$;".";_
  207.               CRLF$;"Welcome to >>>>>>>>>>>>>>>>."
  208.  
  209. 246     ON ERROR_
  210.              GOTO 2900
  211.  
  212.         IF MFG_
  213.              THEN 10020
  214. '.pa
  215.        '** Go to message base selection menu
  216.  
  217.         'Variables:
  218.         ' HOMEBASE$    = User's home message base
  219.         ' M1$          = message base number
  220.         ' UP$          = user's parameters
  221.  
  222.         HOMEBASE$=MID$(UP$,5,1)
  223.  
  224.         IF INSTR("Ww",HOMEBASE$)_
  225.              THEN W=-1:_
  226.                   GOTO 10000
  227.  
  228.         M1$=HOMEBASE$
  229.  
  230.         GOTO 10020
  231.  
  232.         '** Set user defaults
  233.  
  234.         'Variables:
  235.         ' ATO          = auto message read mode
  236.         ' HOMEBASE$    = User's home message base
  237.         ' BEL$         = bell
  238.         ' CC           = CPM comment
  239.         ' CMSG$        = 'Messages'
  240.         ' CN!          = caller number
  241.         ' LM           =
  242.         ' LON$         = last on date
  243.         ' M            =
  244.         ' MFILE$       = name of message base
  245.         ' MSG$         = 'messages'
  246.         ' NN$          =
  247.         ' NULLS        = number of nulls
  248.         ' PAG          = page pause mode
  249.         ' HIMSG        = high message read
  250.         ' UP$          = user's parameters
  251.         ' XPR          = expert mode
  252.  
  253. 280     NN$=MID$(UP$,1,1)
  254.         POKE NULLS,VAL(NN$)
  255.  
  256.         IF MID$(UP$,2,1)="X"_
  257.              THEN XPR=-1_
  258.              ELSE XPR=0
  259.  
  260.         IF MID$(UP$,3,1)="P"_
  261.              THEN ATO=-1_
  262.              ELSE ATO=0
  263.  
  264.         IF MID$(UP$,4,1)="T"_
  265.              THEN PAG=-1_
  266.              ELSE PAG=0
  267.  
  268.         HOMEBASE$=MID$(UP$,5,1)
  269.  
  270.         IF CC_
  271.              THEN 15000
  272.  
  273.         PRINT CRLF$;"Current ";CMSG$;" File: "+MFILE$
  274.         PRINT CRLF$;"You are caller #";CN!
  275.         PRINT "Last on line ";LON$
  276.         PRINT "There are";M;"active messages"
  277.         PRINT "High ";MSG$;" this call is";HIMSG
  278.  
  279.        IF LON$="--"_
  280.              THEN 380
  281.  
  282.         IF LM<=HIMSG_
  283.              THEN PRINT "High ";MSG$;" your last call was";LM:_
  284.                   GOTO 380
  285.  
  286.         PRINT CMSG$;"s have been renumbered.";BEL$
  287. '.pa
  288.         '** Read index, check for mail, load array
  289.  
  290.         'Variables:
  291.         ' ATO          = auto message read mode
  292.         ' CRLF$        = carriage return, line feed
  293.         ' I1$          =
  294.         ' I2$          =
  295.         ' I3$          =
  296.         ' IM           =
  297.         ' LOMSG        = low message read
  298.         ' LM           =
  299.         ' LON$         = last on date
  300.         ' MSGNDX(n,n)  = message array index
  301.         ' ML           =
  302.         ' MX           =
  303.         ' MZ           =
  304.         ' OLD          =
  305.         ' SPCL         = special user
  306.         ' HIMSG        = high message read
  307.         ' UR           =
  308.         ' Z            = number of new messages to user
  309.  
  310. 380     LON$=""
  311.         ML=0
  312.         LMFOUND=0
  313.         Z=0
  314.         OLD=0
  315.         LO=0
  316.         MID=0
  317.         MD=0
  318.  
  319.         GOSUB 30040                             'open index file
  320.  
  321.         GET #1,1
  322.         MZ=CVI(I1$)
  323.         MX=CVI(I2$)
  324.         MID=MZ\2
  325.  
  326.  
  327.        IF MZ=0_
  328.             THEN MZ=1:_
  329.                   CLOSE 1:_
  330.                   GOTO 515
  331.  
  332.  
  333.         FOR I=2 TO MZ
  334.  
  335.              GET #1,I
  336.              MSGNDX(1)=CVI(I1$)
  337.              MSGNDX(2)=CVI(I2$)
  338.              MSGNDX(3)=CVI(I3$)
  339.  
  340.             IF MSGNDX(1)<>0 AND (NOT LO)_
  341.                 THEN LOMSG=MSGNDX(1):_
  342.                 LOMSGRE=I:_
  343.                 LO=-1
  344.  
  345.              IF MSGNDX(1)<>0 AND (I>=MID) AND (NOT MD)_
  346.                 THEN MID=MSGNDX(1):_
  347.                 MIDRE=I:MD=-1
  348.  
  349.              IF MSGNDX(3)=UR_
  350.                   THEN ML=-1:_
  351.                        IF MSGNDX(1)> LM_
  352.                             THEN Z=Z+1_
  353.                             ELSE OLD=-1
  354.  
  355.              IF SPCL AND MSGNDX(3)=1_
  356.                   THEN ML=-1:_
  357.                        IF MSGNDX(1)> LM_
  358.                             THEN Z=Z+1_
  359.                             ELSE OLD=-1
  360.  
  361.         NEXT
  362.         CLOSE 1
  363.  
  364.         IF Z=0_
  365.              THEN ML=0:_
  366.              GOTO 515
  367.  
  368.         PRINT CRLF$;"You have mail waiting."
  369.         PRINT CRLF$;"Enter 'M' to read";Z;"new ";msg$;BEL$
  370.  
  371.         IF Z=1_
  372.              THEN PRINT "."_
  373.              ELSE PRINT "s."
  374.  
  375. 515     IF ML=0_
  376.              THEN PRINT CRLF$;"You have no mail today."
  377.  
  378.         IF HIMSG=LM_
  379.              THEN 520
  380.  
  381.         IF ATO_
  382.              THEN PRINT CRLF$;"(Auto-Read enabled)":_
  383.                   GOSUB 6000                    'read new messages
  384.  
  385. '.pa
  386.         '** Main menu command entry
  387.  
  388.         'Variables:
  389.         ' A1$          =
  390.         ' B$           =
  391.         ' BEL$         = bell
  392.         ' DATE$        = date
  393.         ' FF           = temporary integer, command pointer
  394.         ' CRLF$        = carriage return, line feed
  395.         ' MKR          = marker number in help file
  396.         ' RTC          = memory address of RTC in BYE
  397.         ' SMX          =
  398.         ' TZA          =
  399.         ' XPR          = expert user
  400.  
  401. 520     IF XPR_
  402.              THEN 530_
  403.  
  404.         GOSUB 20000                             'get and format date
  405.         DATE$=DATE$+" "+TZA$
  406.         PRINT CRLF$
  407.         PRINT DATE$;
  408.         PRINT "   [Minutes ";
  409.  
  410.         IF SMX=0 OR PEEK(WHEEL)=255_
  411.              THEN PRINT "on: ";PEEK(RTC+7);"]";:_
  412.              ELSE PRINT "remaining: ";SMX-PEEK(RTC+7);"]";
  413.  
  414. 530     KEY=0
  415.         A1$="COMMAND:"
  416.  
  417.         IF XPR=0 THEN_
  418.                 A1$=CRLF$ +_
  419.                     "(A,B,C,D,E,F,G,H,I,K,L,M,N,P,R,S,U,V,X,<,>) ? for HELP"_
  420.                     +CRLF$+A1$
  421.  
  422.  
  423.         GOSUB 2660                              'print a$ or a1$
  424.         MKR=81
  425.         CAPS=1
  426.         GOSUB 2750                              'get command to b$
  427.  
  428.         IF B$=""_
  429.              THEN 530
  430.  
  431.         FF=INSTR("YERSKGCJIAXDUBNFPMZLHVWQ>.<,",B$)
  432.         GOSUB 570
  433.  
  434.         GOTO 520
  435.  
  436. '.pa
  437. 570     ON FF_
  438.              GOTO 00630,_                       'Y Display Special User file
  439.                   00750,_                       'E Enter a message
  440.                   01620,_                       'R Read messages
  441.                   01880,_                       'S Scan messages
  442.                   02290,_                       'K Kill a message
  443.                   02170,_                       'G Goodbye
  444.                   00650,_                       'C drop to CPM
  445.                   00650,_                       'J drop to CPM
  446.                   02560,_                       'I Inspect User files
  447.                   03190,_                       'A Auto-Read mode toggle
  448.                   03170,_                       'X Expert User toggle
  449.                   03150,_                       'D Set nulls
  450.                   02950,_                       'U Set user parameters
  451.                   00620,_                       'B Display bulletin
  452.                   06000,_                       'N Read New messages
  453.                   10000,_                       'F Set file number
  454.                   03204,_                       'P Set Page Pause
  455.                   01600,_                       'M Read personal mail
  456.                   12000,_                       'Z Print Callers file
  457.                   00615,_                       'L Display long help file
  458.                   03208,_                       'H Set home base
  459.                   08100,_                       'V Show version of QRUN
  460.                   00635,_                       'W What's the new files?
  461.                   00640,_                       'Q QBBS Announcements
  462.                   09000,_                       '> Move up one msg area
  463.                   09000,_                       '. Move up one msg area
  464.                   09010,_                       '< Move down one msg area
  465.                   09010                         ', Move down one msg area
  466.  
  467.         IF LEFT$(B$,1)="/"_
  468.              THEN RETURN
  469.  
  470.         IF VAL(B$)>0 AND VAL(B$)<7_             'TR Mod
  471.              THEN 8900
  472.  
  473.         IF B$="BYE" _
  474.              THEN END
  475.  
  476. 580     PRINT BEL$;
  477.         MKR=81
  478.         GOTO 13000                              'display main menu
  479.         RETURN
  480. '.pa
  481.         '** Display various text files
  482.  
  483.         'Variables:
  484.         ' FIL$         = file name to print
  485.         ' M1$          = message base number
  486.         ' SPCL         = special user
  487.         ' UF$          = user's access level
  488.  
  489.         'display long help file
  490. 615     GOSUB 2640                              'print '^K to abort'
  491.         FIL$="MORE-HLP"
  492.  
  493. '--> convert MORE-HLP to pagination by inserting '----' in left 4
  494. '    columns where you want the page breaks to happen.
  495.  
  496.         DASHFILE = -1                           'CLM: for pagination
  497.         FL = 0
  498.         GOTO 3250                               'display text file
  499.  
  500.         'display bulletin
  501. 620     GOSUB 2640                              'print '^K to abort'
  502.         FL = 0
  503. 621     IF M1$="6"_
  504.              THEN FIL$="S-INFO":_
  505.                   GOTO 3250                     'display text file
  506. 622     FIL$="BULLET"+M1$
  507.         GOTO 3250                               'display text file
  508.  
  509.         'display special user bulletin
  510. 630     IF INSTR("+$S",UF$)_
  511.              THEN FIL$="S-INTRO":_
  512.                   FL = 0:_
  513.                   GOTO 3250_                    'display text file
  514.              ELSE 580
  515.  
  516.         'display FOR file                       'TR MOD
  517. 635     GOSUB 2640
  518.         FIL$="FOR"
  519.         FL = 0
  520.         GOTO 3250
  521.  
  522.         'display QNEWS file
  523. 640     GOSUB 2640                              'TR MOD
  524.         FIL$="QNEWS"
  525.         DASHFILE = -1                           'CLM: for pagination
  526.         GOTO 3250                               'END ADDITIONAL CODE
  527.  
  528. '.pa
  529.         '** CP/M access and password check
  530.  
  531.         'Variables:
  532.         ' A1$          =
  533.         ' B$           =
  534.         ' CFIL$        = name of chain file
  535.         ' CMD          = BDOS command
  536.         ' CPMPASS$     = CPM password
  537.         ' DAT          = BDOS command data
  538.         ' MXML         =
  539.         ' RES          = BDOS result
  540.         ' SPCL         = special user
  541.         ' UF$          = user's access level
  542.         ' XPR          = expert mode
  543.  
  544. 650     IF INSTR("*C",UF$)_
  545.              THEN 8000
  546.  
  547. 675     IF SPCL_
  548.              THEN POKE MXML,0:_
  549.                   GOTO 720
  550.  
  551.         IF CPMPASS$="NOPASS"_
  552.              THEN 720
  553.  
  554.         A1$="Password?"
  555.         GOSUB 2660                              'print a$ or a1$
  556.         GOSUB 2750                              'get command to b$
  557.  
  558.         IF B$<>CPMPASS$_
  559.              THEN PRINT "Invalid password.":_
  560.                   RETURN
  561.  
  562. 720     CMD = 32
  563.         DAT=0
  564.         RES = 0
  565.         CALL BDOS(CMD,DAT,RES)                  'change user areas
  566.  
  567.  
  568.         '** Run COMfile and exit
  569. 735     POKE 0,&HC3
  570.  
  571.         CMD = 65
  572.         CALL BDOS(CMD,DAT,RES)                  'carrier test
  573.  
  574.         IF RES=0_                               'we are not on line
  575.              THEN POKE &H52,&H6A
  576.  
  577.         IF CC = -1_
  578.              THEN END_                          'return from Comment
  579.              ELSE RUN "A:"+CFIL$                'leaving QBBS
  580. '.pa
  581.         '** Enter a message (GB=Goodbye command, CC=CP/M comment)
  582.  
  583.         'Variables:
  584.         ' A$           =
  585.         ' A1$          =
  586.         ' ABORT$       = "Aborted"
  587.         ' ANSR         =
  588.         ' B$           =
  589.         ' BEL$         = bell
  590.         ' CAPS         = capitalization flag
  591.         ' CC           = CPM comment flag
  592.         ' CHC          =
  593.         ' CNTU         =
  594.         ' CMSG$        = 'Message'
  595.         ' CPM$         =
  596.         ' CRLF$        = carriage return, line feed
  597.         ' DUP          =
  598.         ' DEST$        =
  599.         ' F            =
  600.         ' FF           = temporary integer
  601.         ' GB           = goodbye comment
  602.         ' MSGSUBJ$     = message subject
  603.         ' KEY          = full/half duplex flag
  604.         ' KIL          =
  605.         ' L            =
  606.         ' M            =
  607.         ' MKR          = marker number in help file
  608.         ' MPW$         =
  609.         ' MSG          =
  610.         ' MSG$         =
  611.         ' MXML         =
  612.         ' MZ           =
  613.         ' N            =
  614.         ' PR           =
  615.         ' R1           =
  616.         ' RR$          = contents of random record
  617.         ' SAV$         =
  618.         ' SAVID        =
  619.         ' SAVM         =
  620.         ' SAVP         =
  621.         ' SMSG         = sysop message
  622.         ' SUBJ$        = 'Subject'
  623.         ' T            =
  624.         ' MSGTO$       =
  625.         ' HIMSG        = high message read
  626.         ' UF$          = user's access level
  627.         ' UID          =
  628.         ' WW$          =
  629.         ' XPR          = expert mode
  630. '.pa
  631. 750     IF INSTR("*MN",UF$)_
  632.              THEN 8000
  633.  
  634. 751     POKE MXML,0
  635.         SMSG=0
  636.         T=0
  637.         KEY=-1
  638.  
  639.         IF GB_
  640.              THEN 760
  641.  
  642.         IF ANSR AND SAVP_
  643.              THEN PRINT CRLF$;"Kill the above ";MSG$;"? ";:_
  644.                   GOSUB 2750:_                  'get command to b$
  645.                   MKR=0:_
  646.                   B$=LEFT$(B$,1):_
  647.                   IF B$="Y"_
  648.                        THEN M=SAVM:_
  649.                             CLOSE 1:_
  650.                             KIL=-1:_
  651.                             GOSUB 2310          'kill message
  652.  
  653.         IF GB OR CC_
  654.              THEN 760
  655.  
  656.         IF UF$="$"_
  657.              THEN A1$=CRLF$+"SYSOP "+MSG$+"?":_
  658.                   GOSUB 2660:_                  'print a$ or a1$
  659.                   GOSUB 2750:_                  'get command to b$
  660.                   IF B$="Y"_
  661.                        THEN SMSG=-1
  662.  
  663. 760     GOSUB 30010                             'open counter file
  664.  
  665.         GET#1,3
  666.         V=VAL(RR$)
  667.         F=0
  668.         CLOSE 1
  669.  
  670.         IF GB OR CC_
  671.              THEN 800
  672.  
  673.  
  674.         IF ANSR_
  675.              THEN UID=SAVID:_
  676.                   GOTO 795
  677.  
  678.         A1$=CRLF$+"Who to? (<cr> for ALL):"
  679.         GOSUB 2660                              'print a$ or a1$
  680.         MKR=1
  681.         GOSUB 2750                              'get command to b$
  682.  
  683.         IF B$=""_
  684.              THEN MSGTO$="ALL"_
  685.              ELSE MSGTO$=B$
  686.  
  687.         IF LEFT$(MSGTO$,3)="SYS"_
  688.              THEN UID=1:_
  689.                   GOTO 800
  690.  
  691.         IF MSGTO$="ALL"_
  692.              THEN UID=0:_
  693.                   GOTO 800_
  694.              ELSE MSG=2:_
  695.                   GOSUB 2570:_                  'find user
  696.                   MSG=0:_
  697.                   CPM$=LEFT$(DEST$,LEN(MSGTO$)):_
  698.                   IF CPM$<>MSGTO$_
  699.                        THEN PRINT CRLF$;MSGTO$;_
  700.                                  " is not a current user";_
  701.                                  " or name is misspelled.":_
  702.                             RETURN
  703.  
  704. 795     IF ANSR_
  705.              THEN PRINT CRLF$;"To: ";TAB(10);MSGTO$:_
  706.                   GOTO 817
  707.  
  708. 800     IF GB OR CC_
  709.              THEN 905
  710.  
  711.         A1$=SUBJ$+":"
  712.         GOSUB 2660                              'print a$ or a1$
  713.         CAPS=0
  714.         GOSUB 2750                              'get command to b$
  715.         MSGSUBJ$=B$
  716.  
  717.         IF MSGSUBJ$=""_
  718.              THEN PRINT ABORT$:_
  719.                   GB=0:_
  720.                   GOSUB 17000:_                 'timecheck on, wrtloc off
  721.                   IF CC_
  722.                        THEN 735_
  723.                        ELSE RETURN
  724.         GOTO 820
  725.  
  726. 817     IF GB OR CC_
  727.              THEN 1010
  728.  
  729.         SAV$=MSGSUBJ$
  730.         CHC=LEN(MSGSUBJ$)
  731.         PRINT SUBJ$;": ";MSGSUBJ$;
  732.         GOSUB 3510                              'process character input
  733.         B$=SAV$
  734.         SAV$=""
  735.  
  736.         IF B$<>""_
  737.              THEN MSGSUBJ$=B$
  738.  
  739. 820     IF LEN(MSGSUBJ$)>26_
  740.              THEN PRINT CRLF$;SUBJ$;" is too long.";_
  741.                         CRLF$;"Maximum is 25 characters.";_
  742.                         CRLF$;BEL$:_
  743.                   IF (ANSR OR T)_
  744.                        THEN 817_
  745.                        ELSE 800
  746.  
  747.         MPW$=PW$
  748.  
  749.         IF MSGTO$="ALL"_
  750.              THEN IF T_
  751.                   THEN 1010_
  752.                   ELSE 850
  753.  
  754.         A1$="Private? (y,N):"
  755.         GOSUB 2660                              'print a$ or a1$
  756.         GOSUB 2750                              'get command to b$
  757.         B$=LEFT$(B$,1)
  758.  
  759.         IF B$="Y"_
  760.              THEN MPW$=".READ."
  761.  
  762.         IF T_
  763.              THEN 1010
  764.  
  765. 850     IF UPMODE=0_                            'TR MOD
  766.                 THEN B$="K":_
  767.                      GOTO 855
  768.         A1$="(K)eyboard entry or (U)pload"+MODE$+"?"
  769.         GOSUB 2660                              'print a$ or a1$
  770.         GOSUB 2750                              'get command to b$
  771.         B$=LEFT$(B$,1)                          'TR MOD
  772.  
  773. 855     IF B$="U"_
  774.              THEN KEY=0_
  775.              ELSE KEY=-1
  776. '.pa
  777.         '   Open temporary editor file
  778. 905     OPEN "R", 3, "QMSG.$$$", 65
  779.         FIELD #3, 65 AS RR1$
  780.  
  781.         IF T_
  782.              THEN 1010
  783.  
  784.         PRINT "Enter ";MSG$;
  785.         IF KEY_
  786.              THEN PRINT " (Keyboard entry)"_
  787.              ELSE PRINT " (Upload"+MODE$+")"
  788.  
  789.  
  790.         IF KEY_
  791.              THEN PRINT "Hit RETURN twice";_
  792.              ELSE PRINT "Enter '/' on a blank line";
  793.  
  794.         PRINT " for EDIT menu"
  795.         WR$=""
  796. 930     PRINT ":";STRING$(61,45);":"
  797.  
  798.         IF KEY=0_
  799.              THEN DUP=0
  800.  
  801.         BLK = 0                                 'Count the blank lines
  802.  
  803. 950     F=F+1
  804.  
  805.         IF WW$<>""_
  806.              THEN PRINT WW$;:_
  807.                   CHC=LEN(WW$):_
  808.                   WW$="":_
  809.                   GOSUB 3510:_                  'process character input
  810.                   GOTO 980
  811.  
  812.         N=1
  813.         MKR=0
  814.         GOSUB 3500                              'process input character
  815.  
  816.  
  817.         IF SAV$=""_
  818.              THEN IF KEY_
  819.                   THEN F=F-1:_
  820.                        GOTO 1010_
  821.                   ELSE BLK = BLK + 1_
  822.              ELSE BLK = 0
  823.  
  824.         IF BLK = 10_
  825.              THEN PRINT "Enter '/' on a blank line for EDIT menu" + BEL$:_
  826.                   BLK = 0
  827. '.pa
  828.         IF KEY=0 AND SAV$="/"_
  829.              THEN F=F-1:_
  830.                   GOTO 1010
  831.  
  832. 980     B$=SAV$
  833.         SAV$=WW$
  834.  
  835.         LSET RR1$ = B$ + " "
  836.         PUT#3, F
  837.         GOTO 950
  838.  
  839. 1010    PRINT:
  840.         A1$ = "(" + MID$(STR$(F),2) + " lines entered)" + CRLF$
  841.  
  842.         IF XPR_
  843.              THEN A1$ = A1$ + "(A,C,D,E,I,L,P,S,T,?):"_
  844.              ELSE A1$ = A1$ +_
  845.                   "(A)bort   (C)ontinue (D)elete (E)dit  (L)ist " + CRLF$ +_
  846.                   "(I)nsert  (P)review  (S)ave   (T)itle (? for HELP):"
  847.  
  848.         GOSUB 2660                              'print a$ or a1$
  849.  
  850.         DUP=-1
  851.         KEY = -1
  852.         PR=0
  853.         MKR=82
  854.         GOSUB 2750                              'get command to b$
  855.  
  856.         IF R1_
  857.              THEN CNTU=0
  858.  
  859.        IF B$=""_
  860.             THEN IF NCH=63_
  861.                 THEN 1010_
  862.             ELSE B$="L"
  863.  
  864.        FF = INSTR("PLADICEST",LEFT$(B$,1))
  865.  
  866.         ON FF_
  867.              GOTO 1020,_                        'P list msg w/o line #
  868.                   1022,_                        'L list msg w/line #
  869.                   1024,_                        'A answer msg
  870.                   1300,_                        'D delete a line
  871.                   1340,_                        'I insert a line
  872.                   0950,_                        'C continue
  873.                   1150,_                        'E edit a line
  874.                   1390,_                        'S save message
  875.                   1030                          'T change msg title
  876.                                                 ' will default to listing
  877.                                                 ' msg w/o line numbers.
  878.         IF SAV$ = "?"_                          'User had asked for help
  879.              THEN GOTO 1010
  880.  
  881.  
  882. 1020    PR=-1                                   'list msg w/o line #
  883.  
  884. 1022    GOSUB 2640                              'list msg w / line #
  885.         PRINT
  886.         LL = 1
  887.  
  888.         FOR L = 1 TO F
  889.  
  890.              IF PR = 0_
  891.                   THEN PRINT RIGHT$("   " + STR$(L) + "> ", 5);
  892.  
  893.              GET #3, L
  894.  
  895.              RR$ = RR1$
  896.              GOSUB 3110
  897.              A$ = S$
  898.              GOSUB 2660
  899.  
  900.              LL = LL + 1
  901.              IF LL MOD PAGLEN = 0_
  902.                   THEN GOSUB 21000              '(more?)
  903.  
  904.              IF BI = 11 OR BI = 24_             'abort with ^K/K/k/^X/X/x
  905.                   THEN L = F
  906.  
  907.         NEXT L
  908.  
  909.         A$ = ""
  910.         PRINT
  911.  
  912.         GOTO 1010
  913.  
  914. 1024    A1$="Abort?"
  915.         GOSUB 2660
  916.         GOSUB 2750
  917.         B$=LEFT$(B$,1)
  918.         IF B$<>"Y" THEN 1010
  919.  
  920.         PRINT ABORT$                            'abort msg
  921.         GOSUB 17000                             'timecheck on, wrtloc off
  922.         GOSUB 18000                             'close and delete temp file
  923.         IF GB_
  924.              THEN 2280_
  925.              ELSE IF CC_
  926.                        THEN 735_
  927.                        ELSE RETURN
  928.  
  929. 1030    T=-1                                    'change title of msg
  930.         PRINT
  931.         GOTO 817
  932.  
  933.  
  934.         '** Line editing routines
  935.  
  936.         'Variables:
  937.         ' A1$          =
  938.         ' ABORT$       = "Aborted"
  939.         ' ANS          =
  940.         ' B$           =
  941.         ' BEL$         = bell
  942.         ' CRLF$        = carriage return, line feed
  943.         ' F            = highest element in array
  944.         ' L            =
  945.         ' LENGTH       = length of line
  946.         ' NAM$         =
  947.         ' NUM          =
  948.         ' R            =
  949.  
  950. 1150    PRINT
  951.         A1$="Edit which line?"
  952.         GOSUB 2660                              'print a$ or a1$
  953.         GOSUB 2750                              'get command to b$
  954.         L=VAL(B$)
  955.  
  956. 1160    IF L=0 OR L>F_
  957.              THEN 1010_
  958.              ELSE GET #3, L:_
  959.                   PRINT CRLF$;"Original Line:";_
  960.                         CRLF$;LEFT$(RR1$,63)
  961.  
  962.         LENGTH=63
  963.  
  964.         IF R=1_
  965.              THEN 1167_
  966.              ELSE GET #3, L:_
  967.                   NAM$=LEFT$(RR1$,63)
  968.  
  969.         NAM$=NAM$+STRING$(LENGTH-LEN(NAM$),160)
  970.  
  971. 1167    PRINT CRLF$;_
  972.           "Edit Line: (Ctrl-V for HELP, Ctrl-Q to ABORT, Return to END):"
  973.         PRINT NAM$+CHR$(13);
  974.         R=0
  975.  
  976.         FOR NUM = 1 TO LENGTH
  977.  
  978.              '** Get/process single character
  979. 1171         ANS=ASC(INPUT$(1))
  980.  
  981.              IF ANS=13_
  982.                   THEN 1260
  983.  
  984.              IF ANS=30 OR ANS=5_
  985.                   THEN ANS=94
  986.  
  987.              IF ANS=8 OR ANS=19_
  988.                   THEN ANS=60
  989.  
  990.              IF ANS=12 OR ANS=4_
  991.                   THEN ANS=62
  992.  
  993.              '** Filter out unwanted control characters
  994.              IF ANS<17 OR ANS=18 OR ANS=20 OR ANS=21_
  995.                   THEN 1171
  996.  
  997.              IF ANS=23 OR (ANS>24 AND ANS<32)_
  998.                   THEN 1171
  999.  
  1000.              PRINT CHR$(ANS);
  1001.  
  1002.              IF ANS=62 AND NUM=LENGTH_
  1003.                   THEN PRINT CHR$(8);MID$(NAM$,NUM,1);_
  1004.                              CHR$(8);BEL$;:_
  1005.                        NUM=NUM-1:_
  1006.                        GOTO 1250
  1007.  
  1008.              IF ANS=62_
  1009.                   THEN PRINT CHR$(8);MID$(NAM$,NUM,1);:_
  1010.                        GOTO 1250
  1011.  
  1012.              IF ANS=60  AND NUM>1_
  1013.                   THEN PRINT CHR$(8);MID$(NAM$,NUM,1);_
  1014.                              CHR$(8);CHR$(8);:_
  1015.                        NUM=NUM-2:_
  1016.                        GOTO 1250
  1017.  
  1018.              IF ANS=60 AND NUM=1_
  1019.                   THEN PRINT CHR$(8);MID$(NAM$,NUM,1);CHR$(8);:_
  1020.                        NUM=NUM-1:_
  1021.                        GOTO 1250
  1022.  
  1023.              IF ANS=94_
  1024.                   THEN NAM$=LEFT$(NAM$,NUM-1)+" "+_
  1025.                             MID$(NAM$,NUM,LENGTH-NUM):_
  1026.                        PRINT CHR$(8);RIGHT$(NAM$,LENGTH-NUM+1);_
  1027.                              STRING$(LENGTH-NUM+1,8);:_
  1028.                        NUM=NUM-1:_
  1029.                        GOTO 1250
  1030. '.pa
  1031.              IF ANS=24_
  1032.                   THEN NAM$=LEFT$(NAM$,NUM-1)+RIGHT$(NAM$,LENGTH-NUM)+_
  1033.                             CHR$(160):_
  1034.                        PRINT RIGHT$(NAM$,LENGTH-NUM+1);_
  1035.                              STRING$(LENGTH-NUM+1,8);:_
  1036.                        NUM=NUM-1:_
  1037.                        GOTO 1250
  1038.  
  1039.              IF ANS=22_
  1040.                   THEN PRINT CRLF$;CRLF$;_
  1041.                              "'<' = Move Left, '>' = Move Right, ";_
  1042.                              "'^' = Ins CHR, 'Ctrl-X' = Del CHR":_
  1043.                        R=1:_
  1044.                        GOTO 1160
  1045.  
  1046.              IF ANS=17_
  1047.                   THEN PRINT CRLF$;"EDIT ";ABORT$:_
  1048.                        GOTO 1010
  1049.  
  1050.              NAM$=LEFT$(NAM$,NUM-1) +CHR$(ANS)+RIGHT$(NAM$,LENGTH-NUM)
  1051.  
  1052.              IF NUM=LENGTH_
  1053.                   THEN PRINT CHR$(8);:_
  1054.                        NUM=NUM-1
  1055.  
  1056. 1250    NEXT NUM
  1057.  
  1058. 1260    FOR NUM=1 TO LENGTH
  1059.              IF MID$(NAM$,NUM,1)=CHR$(160)_
  1060.                   THEN NAM$=LEFT$(NAM$,NUM-1)+" "+_
  1061.                             RIGHT$(NAM$,LENGTH-NUM)
  1062.         NEXT NUM
  1063.  
  1064.         LSET RR1$ = NAM$
  1065.         PUT#3, L
  1066.         PRINT
  1067.  
  1068.         GOTO 1010
  1069. '.pa
  1070.         '** DELETE a line
  1071.  
  1072.         'Variables:
  1073.         ' A$           =
  1074.         ' A1$          =
  1075.         ' B$           =
  1076.         ' D            =
  1077.         ' F            = highest line in message array
  1078.         ' MKR          = marker number in help file
  1079.         ' NOSUCH$      = "Line does not exist"
  1080.         ' X            =
  1081.  
  1082.  
  1083. 1300    A1$="Line # to DELETE:"
  1084.         GOSUB 2660                              'print a$ or a1$
  1085.         MKR=0
  1086.         GOSUB 2750                              'get command to b$
  1087.         D=VAL(B$)
  1088.  
  1089.         IF D=0 OR D>F_
  1090.              THEN PRINT NOSUCH$:_
  1091.                   GOTO 1010
  1092.  
  1093.         PRINT "Line #"+STR$(D)+":"
  1094.         GET #3, D
  1095.         PRINT RR1$
  1096.         A$="Delete this line?"
  1097.         GOSUB 2660                              'print a$ or a1$
  1098.         GOSUB 2750                              'get command to b$
  1099.  
  1100.         IF B$<>"Y"_
  1101.              THEN PRINT "Not deleted":_
  1102.                   GOTO 1010
  1103.  
  1104.         FOR X= D TO F
  1105.              GET #3, X+1
  1106.              PUT #3, X
  1107.         NEXT
  1108.  
  1109.         F=F-1
  1110.         PRINT "Line deleted"
  1111.         GOTO 1010
  1112. '.pa
  1113.         '** INSERT a line
  1114.  
  1115.         'Variables:
  1116.         ' A1$          =
  1117.         ' B$           =
  1118.         ' F            = highest line number in array
  1119.         ' INS          = insert mode flag
  1120.         ' LN           =
  1121.         ' MKR          = marker number in help file
  1122.         ' N            =
  1123.         ' NOSUCH$      = "Line does not exist"
  1124.         ' SAV$         =
  1125.         ' X            =
  1126.  
  1127.  
  1128. 1340    A1$="INSERT before line #:"
  1129.         GOSUB 2660                              'print a$ or a1$
  1130.         MKR=0
  1131.         GOSUB 2750                              'get command to b$
  1132.         LN=VAL(B$)
  1133.  
  1134.         IF LN=0 OR LN>F_
  1135.              THEN PRINT NOSUCH$:_
  1136.                   GOTO 1385
  1137.  
  1138.         A$=STR$(LN)+">"
  1139.  
  1140.         IF LN<10_
  1141.              THEN A$=" "+A$
  1142.  
  1143.         N=1
  1144.         INS=-1
  1145.         GOSUB 2660                              'print a$ or a1$
  1146.         GOSUB 3500                              'process input character
  1147.  
  1148.         IF SAV$=""_
  1149.              THEN 1385
  1150.  
  1151.         FOR X= F TO LN STEP -1
  1152.              GET #3, X
  1153.              PUT #3, X+1
  1154.         NEXT X
  1155.  
  1156.         F=F+1
  1157.         LSET RR1$ = SAV$
  1158.         PUT #3,LN
  1159. 1385    SAV$=""
  1160.         INS=0
  1161.         GOTO 1010
  1162. '.pa
  1163.         '** Save message
  1164.  
  1165.         'Variables:
  1166.         ' ANSR         =
  1167.         ' CC           = CP/M comment flag
  1168.         ' CRLF$        = carriage return, line feed
  1169.         ' DATE$        = date
  1170.         ' F            =
  1171.         ' FLS          =
  1172.         ' GB           = goodbye flag
  1173.         ' I1$          =
  1174.         ' I2$          =
  1175.         ' I3$          =
  1176.         ' MSGSUBJ$     = message subject
  1177.         ' MSGNDX(n,n)  = message array index
  1178.         ' MFILE$       = name of message base
  1179.         ' MPW$         =
  1180.         ' MSG$         = "message"
  1181.         ' MX           =
  1182.         ' MZ           =
  1183.         ' N$           = user's first name
  1184.         ' O$           = user's last name
  1185.         ' P            = loop counter
  1186.         ' R1           =
  1187.         ' RE           = random record number
  1188.         ' RL           = length of random record
  1189.         ' RR$          = contents of random record
  1190.         ' S$           = temporary string before placing in random buffer
  1191.         ' SAVRE        = saved record number in message file
  1192.         ' SMGS         = sysop message flag
  1193.         ' SPW$         = message password
  1194.         ' MSGTO$       = message to:
  1195.         ' HIMSG        = high message read
  1196.         ' UF$          = user access level
  1197.         ' UID
  1198.         ' UR
  1199.         ' V
  1200.         ' WRTLOC       = write lock
  1201.  
  1202. 1390    SPW$=";"+MPW$
  1203.  
  1204.         IF GB OR CC_
  1205.           THEN 1410
  1206.  
  1207.         PRINT CRLF$;"Saving ";MSG$;" #";STR$(V+1);_
  1208.               " in ";MFILE$;" ";MSG$;" file.";CRLF$
  1209.  
  1210.         IF UF$="$" AND F=0_
  1211.              THEN FLS=-1
  1212.  
  1213. 1410    GOSUB 20000                             'get and format date
  1214.         POKE WRTLOC,255
  1215.  
  1216. 1510    GOSUB 30010                             'open counter file
  1217.  
  1218. 1520    GET#1,3
  1219.         LSET RR$=STR$(VAL(RR$)+1)
  1220.         PUT#1,3
  1221.  
  1222. 1521    GET#1,1
  1223.         LSET RR$=STR$(VAL(RR$)+1)
  1224.         PUT#1,1
  1225.  
  1226. 1522    CLOSE 1
  1227.         GOSUB 30030                             'open message file
  1228.         RL=65                                   '** MESSAGE
  1229.         RE=MX+1
  1230.         SAVRE=RE
  1231.         S$=STR$(V+1)+SPW$
  1232.         GOSUB 3100                              'place s$ in random buffer
  1233.  
  1234. 1523    PUT#1,RE
  1235.         S$=DATE$
  1236.         GOSUB 3100                              'place s$ in random buffer
  1237.  
  1238. 1524    IF FLS_
  1239.              THEN MID$(RR$,57)="1":_
  1240.                   FLS=0
  1241.  
  1242. 1525    PUT#1,RE+1
  1243.  
  1244. 1526    IF SMSG_
  1245.              THEN S$="SYSOP"_
  1246.              ELSE S$=N$+" "+O$
  1247.  
  1248. 1527    GOSUB 3100                              'place s$ in random buffer
  1249.         MID$(RR$,56)=STR$(UR)
  1250.         PUT#1,RE+2
  1251.  
  1252. 1528    S$=MSGTO$
  1253.         GOSUB 3100                              'place s$ in random buffer
  1254.         MID$(RR$,56)=STR$(UID)
  1255.         PUT#1,RE+3
  1256.  
  1257. 1529    S$=MSGSUBJ$
  1258.         GOSUB 3100                              'place s$ in random buffer
  1259.         PUT#1,RE+4
  1260.  
  1261. 1530    S$=STR$(F)
  1262.         GOSUB 3100                              'place s$ in random buffer
  1263.         PUT#1,RE+5
  1264.  
  1265. 1531    RE=RE+6
  1266.  
  1267. 1532    FOR P=1 TO F
  1268.              GET#3, P
  1269.              S$ = RR1$
  1270.              GOSUB 3100                         'place s$ in random buffer
  1271.              PUT#1,RE
  1272.              RE=RE+1
  1273.  
  1274.              IF P MOD 10 = 0_
  1275.                   THEN PRINT STR$(P) + " lines saved." + CHR$(13);
  1276.         NEXT P
  1277.  
  1278. 1533    S$="32000"
  1279.         GOSUB 3100                              'place s$ in random buffer
  1280.         PUT#1,RE
  1281.  
  1282. 1534    CLOSE 1
  1283.         MX=MX+F+6
  1284.         MZ=MZ+1
  1285.         HIMSG=HIMSG+1
  1286.         GOSUB 30040                             'open index file
  1287.  
  1288. 1535    LSET I1$=MKI$(MZ)
  1289.         LSET I2$=MKI$(MX)
  1290.         PUT #1,1    '** INDEX
  1291.  
  1292. 1536    LSET I1$=MKI$(V+1)
  1293.         LSET I2$=MKI$(SAVRE)
  1294.         LSET I3$=MKI$(UID)
  1295.         PUT #1,MZ
  1296.  
  1297. 1537    CLOSE 1
  1298.         PRINT STR$(P-1) + " lines saved."
  1299.         POKE WRTLOC,0
  1300.         GOSUB 18000                             'close and delete temp file
  1301.         GOSUB 17000                             'timecheck on, wrtloc off
  1302.  
  1303. 1538    IF GB OR CC THEN_
  1304.              PRINT CRLF$;"Thanks for the comment, ";N$
  1305.  
  1306.         IF CC_
  1307.              THEN 735_
  1308.              ELSE IF GB_
  1309.                   THEN END
  1310.  
  1311.         IF R1_
  1312.              THEN CNTU=0
  1313.  
  1314.         ANSR=0
  1315.  
  1316.         RETURN
  1317. '.pa
  1318.         '** Read personal mail
  1319.  
  1320.         'Variables:
  1321.         ' A1$          =
  1322.         ' CRLF$        = carriage return, line feed
  1323.         ' B$           =
  1324.         ' ML1          =
  1325.         ' NEWR         =
  1326.         ' OLDR         =
  1327.         ' OLD          =
  1328.         ' SAVI         =
  1329.  
  1330.  
  1331. 1600    ML1=-1
  1332.         CLOSE 1
  1333.  
  1334.         A1$=CRLF$+"Re-read old mail?"
  1335.         GOSUB 2660                              'print a$ or a1$
  1336.         GOSUB 2750                              'get command to b$
  1337.  
  1338.         IF LEFT$(B$,1)="Y"_
  1339.              THEN OLDR=-1:SAVI=1:_
  1340.         ELSE NEWR=-1:SAVI=1 'SAVI=LMI
  1341.  
  1342. 1602    P1=1
  1343.         SKP=-1
  1344.         CNTU=0
  1345.         LMSG=0
  1346.         R1=0
  1347.  
  1348.         CLOSE 1
  1349.         GOSUB 30040                'OPEN MESSAGE INDEX
  1350.         MGOT=0
  1351.  
  1352.         FOR I=SAVI+1 TO MZ
  1353.              GET #1,I
  1354.              MSGNDX(1)=CVI(I1$)
  1355.              MSGNDX(2)=CVI(I2$)
  1356.              MSGNDX(3)=CVI(I3$)
  1357.              M3=MSGNDX(3)
  1358.              IF MSGNDX(1)=0_
  1359.                   THEN 1603
  1360.  
  1361.              IF OLDR AND M3=UR AND MSGNDX(1)<LM_
  1362.                   THEN SAVI=I:MGOT=-1
  1363.              IF NEWR AND M3=UR AND MSGNDX(1)>LM_
  1364.                   THEN SAVI=I:MGOT=-1
  1365.              IF MGOT_
  1366.                   THEN MRE=MSGNDX(2):_
  1367.                        CLOSE 1:_
  1368.                        GOTO 1685
  1369.  
  1370.              MGOT=0
  1371.  
  1372.              IF NOT SPCL THEN 1603
  1373.              IF OLDR AND M3=1 AND MSGNDX(1)<LM_
  1374.                   THEN SAVI=I:MGOT=-1
  1375.              IF NEWR AND M3=1 AND MSGNDX(1)>LM_
  1376.                   THEN SAVI=I:MGOT=-1
  1377.              IF MGOT_
  1378.                THEN MRE=MSGNDX(2):_
  1379.                CLOSE 1:_
  1380.                GOTO 1685
  1381.  
  1382. 1603    NEXT I
  1383.  
  1384.         GOTO 1870
  1385.  
  1386. 1618    IF D1=0_
  1387.              THEN 1620                          'read messages
  1388.         PRINT CRLF$;"No new messages found."
  1389.         D1=0
  1390.  
  1391.         RETURN
  1392. '.pa
  1393.         '** Prompt to read individual messages
  1394.  
  1395.         'Variables:
  1396.         ' A1$          =
  1397.         ' B$           =
  1398.         ' CNTU         =
  1399.         ' CRLF$        = carriage return, line feed
  1400.         ' G            =
  1401.         ' LOMSG        = low message read
  1402.         ' LMSG         =
  1403.         ' M            =
  1404.         ' MI           =
  1405.         ' MKR          = marker number in help file
  1406.         ' ML1          =
  1407.         ' MSG$         = "message"
  1408.         ' MZ           =
  1409.         ' P1           =
  1410.         ' PAG          = page pause mode
  1411.         ' OK           =
  1412.         ' R1           =
  1413.         ' RE           = randcom record number
  1414.         ' SKP          = skip flag
  1415.         ' HIMSG        = high message read
  1416.         ' XPR          = expert mode
  1417.  
  1418.  
  1419.  
  1420. 1620    PRINT
  1421.         A1$=CMSG$+" # ("+MID$(STR$(LOMSG),2)+"-"+MID$(STR$(HIMSG),2)+")"
  1422.  
  1423.         IF XPR=0_
  1424.              THEN A1$=A1$+" to read? (C/R to end)"
  1425.  
  1426.         A1$=A1$+":"
  1427.         GOSUB 2660                              'print a$ or a1$
  1428.         DISP=0
  1429.         MKR=2
  1430.         PAST=0
  1431.         DEL=0
  1432.         GOSUB 2750                              'get command to b$
  1433.  
  1434. 1640    IF LEN(B$)=0_
  1435.              THEN M=0_
  1436.              ELSE M=VAL(B$)
  1437. '.pa
  1438. 1650    IF M<1_
  1439.              THEN PRINT:_
  1440.              GOTO 1870
  1441.  
  1442.         IF M>HIMSG_
  1443.              THEN 1618_
  1444.              ELSE IF ML1=0_
  1445.                   THEN GOSUB 2640               'print '^K to abort'
  1446.  
  1447.  
  1448.         P1=1
  1449.         SKP=-1
  1450.         CNTU=0
  1451.         LMSG=0
  1452.         R1=0
  1453.  
  1454.         IF (NOT XPR)_
  1455.              THEN PRINT "Enter ^X,X,x to skip this ";MSG$;
  1456.  
  1457.         IF RIGHT$(B$,1)="+"_
  1458.              THEN CNTU=-1_
  1459.              ELSE R1=-1
  1460.  
  1461. 1680    GOSUB 31000                             'find message in index
  1462.  
  1463.         IF MRE=0 THEN PRINT BEL$;:RETURN
  1464.  
  1465. 1685    GOSUB 30030                             'open message file
  1466.  
  1467. 1690    GOSUB 3440                              'test for private message
  1468.  
  1469.         IF PAST THEN 1870
  1470.  
  1471.         IF OK=0 OR M=0_
  1472.              THEN 1690
  1473.  
  1474. 1721    IF SKP_
  1475.              THEN CNTU=-1:_
  1476.                   GOTO 1755
  1477.  
  1478.         IF PAG AND P1=0_
  1479.              THEN 1723_
  1480.              ELSE 1755
  1481. '.pa
  1482.         '** Process message options
  1483.  
  1484.         'Variables:
  1485.         ' ANSR         =
  1486.         ' B$           =
  1487.         ' CMD          = BDOS command
  1488.         ' CNTU         =
  1489.         ' D1           =
  1490.         ' KKIL         =
  1491.         ' LMSG         =
  1492.         ' LST          = line printer flag
  1493.         ' M            =
  1494.         ' ML1          =
  1495.         ' NO$          =
  1496.         ' R1           =
  1497.         ' RES          = BDOS result
  1498.         ' SAVM         =
  1499.         ' SAVP         =
  1500.         ' SKP          = skip flag
  1501.         ' SPCL         = special user
  1502.         ' MSGTO$       = message to:
  1503.         ' UF$          = user's access level
  1504.         ' XPR          = expert mode
  1505.  
  1506. 1723    IF XPR_
  1507.              THEN PRINT "R,A,N,Q";_
  1508.              ELSE PRINT "(R)ead again, (A)nswer, ";_
  1509.                         "(N)ext, (Q)uit";
  1510.  
  1511.         IF SAVP OR SPCL_
  1512.              THEN IF XPR_
  1513.                        THEN PRINT ",K";_
  1514.                        ELSE PRINT ", (K)ill";
  1515.  
  1516.         IF UF$="$"_
  1517.              THEN IF XPR_
  1518.                        THEN PRINT ",P";_
  1519.                        ELSE PRINT ", (P)rint";
  1520.  
  1521.         PRINT ": ";
  1522. '.pa
  1523. 1726    B$=INPUT$(1)
  1524.         CALL UCASE(B$)
  1525.         LST=0
  1526.  
  1527.         FF=INSTR("RANQKP "+CHR$(13),B$)
  1528.  
  1529.         ON FF_
  1530.              GOTO 1730,_                        'R read msg again
  1531.                   1734,_                        'A answer msg
  1532.                   1740,_                        'N read next msg
  1533.                   1738,_                        'Q quit msg read
  1534.                   1736,_                        'K kill msg
  1535.                   1732,_                        'P print hard copy
  1536.                   1740,_                        '<space> read next msg
  1537.                   1740                          '<cr> read next msg
  1538.  
  1539.         GOTO 1726
  1540.  
  1541. 1730    M=SAVM                                  'read msg again
  1542.         PRINT B$
  1543.         CLOSE 1
  1544.         SKP=-1
  1545.         GOTO 1680
  1546.  
  1547. 1732    IF UF$<>"$"_                            'print hard copy
  1548.              THEN 1726
  1549.  
  1550.         CMD = 65
  1551.         CALL BDOS(CMD,DAT,RES)                  'carrier test
  1552.         IF RES=255_
  1553.              THEN 1726_
  1554.              ELSE M=SAVM:_
  1555.                   CLOSE 1:_
  1556.                   SKP=-1:_
  1557.                   LST=-1:_
  1558.                   GOTO 1680
  1559.  
  1560. 1734    MSGTO$=NO$:_                            'answer msg
  1561.         ANSR=-1:_
  1562.         PRINT B$:_
  1563.         CLOSE 1:_
  1564.         GOSUB 750:_                             'enter a message
  1565.         ANSR=0:_
  1566.         IF ML1_
  1567.              THEN 1602_
  1568.              ELSE IF CNTU_
  1569.                        THEN B$=STR$(SAVM)+"+":_
  1570.                             D1=0:_
  1571.                             GOTO 1650_
  1572.                        ELSE CLOSE 1:_
  1573.                             GOTO 1620           'read messages
  1574. '.pa
  1575. 1736    IF SAVP=0 AND SPCL=0_
  1576.              THEN 1726
  1577.  
  1578.         CLOSE 1                                 'kill message
  1579.         PRINT B$
  1580.         KKIL=-1
  1581.         M=SAVM
  1582.         GOSUB 2310                              'kill message
  1583.         IF ML1 THEN 1602_
  1584.              ELSE M=SAVM+1:_
  1585.                   SKP=-1:_
  1586.                   GOTO 1650
  1587.  
  1588. 1738    PRINT B$                                'quit msg read
  1589.         PRINT
  1590.         GOTO 1870
  1591.  
  1592. 1740    PRINT B$                                'read next msg
  1593.  
  1594. 1747    CNTU=-1
  1595.  
  1596.         IF LMSG_
  1597.              THEN 1870_
  1598.              ELSE IF ML1_
  1599.                   THEN 1602
  1600.  
  1601.         IF R1_
  1602.              THEN CLOSE 1:_
  1603.                   GOTO 1620                     'read messages
  1604.  
  1605.         PRINT
  1606. '.pa
  1607.         '** Get/Display message
  1608.  
  1609.         'Variables:
  1610.         ' A$           =
  1611.         ' BI           =
  1612.         ' CRLF$        = carriage return, line feed
  1613.         ' CNTU         =
  1614.         ' D1           =
  1615.         ' DATE$        = date
  1616.         ' FL           =
  1617.         ' G            =
  1618.         ' J            =
  1619.         ' MSGSUBJ$     = message subject
  1620.         ' LMSG         =
  1621.         ' LST          = line printer flag
  1622.         ' M            =
  1623.         ' MFILE$       = name of message base
  1624.         ' MI           =
  1625.         ' ML1          =
  1626.         ' NEWR         =
  1627.         ' NO$          =
  1628.         ' OLDR         =
  1629.         ' P            = loop counter
  1630.         ' P1           =
  1631.         ' PAG          = page pause mode
  1632.         ' PERS         =
  1633.         ' PR$          = "Personal" or "Public"
  1634.         ' RCV          = message received flag
  1635.         ' SAVID        =
  1636.         ' RCV$         = message received
  1637.         ' RE           = random record number
  1638.         ' RR$          = contents of random record
  1639.         ' S$           =
  1640.         ' SAVM         =
  1641.         ' SAVP         =
  1642.         ' SAVRC        =
  1643.         ' SAVUID       =
  1644.         ' SKP          = skip message flag
  1645.         ' SPCL         = special user
  1646.         ' MSGTO$       = message to:
  1647.         ' HIMSG        = high message read
  1648.         ' UID          =
  1649.         ' UR           =
  1650.  
  1651. 1755    SAVM=M
  1652.         SAVP=PERS
  1653.         RCV=0
  1654.  
  1655.         GET#1,RE+1
  1656.         GOSUB 30050                             'zero msg flags for display
  1657.         GOSUB 3110                              'clear trailing spaces
  1658.         DATE$=S$
  1659.  
  1660.         IF UID=1_
  1661.              THEN FL=-1
  1662.  
  1663.         GET#1,RE+2
  1664.         GOSUB 30050                             'zero msg flags for display
  1665.         GOSUB 3110                              'clear trailing spaces
  1666.         NO$=S$
  1667.         SAVID=UID
  1668.  
  1669.         GET#1,RE+3
  1670.         GOSUB 30050                             'zero msg flags for display
  1671.         GOSUB 3110                              'clear trailing spaces
  1672.         MSGTO$=S$
  1673.         SAVUID=UID
  1674.  
  1675.         GET#1,RE+4
  1676.         GOSUB 30050                             'zero msg flags for display
  1677.         GOSUB 3110                              'clear trailing spaces
  1678.         MSGSUBJ$=S$
  1679.         SAVRC=RE+4
  1680.  
  1681.         GET#1,RE+5
  1682.         J=VAL(RR$)
  1683.         P1=0
  1684.         SKP=0
  1685.  
  1686.         RE=RE+6
  1687.  
  1688.         IF UID=1_
  1689.              THEN RCV$="  <Rcvd>"_
  1690.              ELSE RCV$=""
  1691.  
  1692.         IF PERS_
  1693.              THEN PR$="Private"_
  1694.              ELSE PR$="Public"
  1695.  
  1696.         IF LST_
  1697.              THEN LPRINT CRLF$;"#";M;NO$;" --> "MSGTO$;_
  1698.                          RCV$;" --> ";MSGSUBJ$;_
  1699.                          " <";MFILE$;">";"<";PR$;">";_
  1700.                          CRLF$;DATE$;CRLF$
  1701.  
  1702.         PRINT CRLF$;STRING$(50,61)
  1703.         PRINT " MSG#: " ;STR$(M);TAB(18);       "|  FROM:  ";NO$
  1704.         PRINT " DATE:  ";LEFT$(DATE$,8);TAB(18);"|    TO:  ";MSGTO$;RCV$
  1705.         PRINT " TIME:  ";MID$(DATE$,10);TAB(18);"|  SUBJ:  ";MSGSUBJ$
  1706.         PRINT " TYPE:  ";PR$;TAB(18);           "|  FILE:  ";MFILE$
  1707.         PRINT STRING$(50,45)
  1708.         LL = 6                                  'for (more?) pause
  1709. '.pa
  1710.         '** Display text file if flag set
  1711.  
  1712.         IF FL_
  1713.              THEN FIL$=MID$(STR$(M),2)+".MF"+M1$:_
  1714.                   GOSUB 3250:_                  'display text file
  1715.                   FL=0:_
  1716.                   IF BI = 11_
  1717.                        THEN 1850_               'user aborted
  1718.                        ELSE 1820
  1719.  
  1720.         '** Display message from message file
  1721.  
  1722.         FOR P=1 TO J
  1723.  
  1724.              GET#1,RE
  1725.              GOSUB 3110                         'clear trailing spaces
  1726.              A$=S$
  1727.              GOSUB 2660                         'print a$ or a1$
  1728.  
  1729.              LL = LL + 1
  1730.              IF LL MOD PAGLEN = 0 AND PAG <> 0_ 'page pause
  1731.                   THEN GOSUB 21000              '(more?)
  1732.  
  1733.              IF BI=11_                          '^K/K/k abort read
  1734.                   THEN 1850
  1735.  
  1736.              IF BI=24_                          '^X/X/x skip message
  1737.                   THEN PRINT CRLF$;"[Skipping message]":_
  1738.                        IF ML1_
  1739.                             THEN 1602_
  1740.                             ELSE BI=0:_
  1741.                                  SKP=-1:_
  1742.                                  GOTO 1850
  1743.  
  1744.              RE = RE + 1
  1745.  
  1746.         NEXT P
  1747.  
  1748. 1820    PRINT
  1749.  
  1750.         IF UR=SAVUID_
  1751.              THEN RCV=-1
  1752.  
  1753.         IF SAVUID=1 AND SPCL_
  1754.              THEN RCV=-1
  1755.  
  1756.         IF UID=1_
  1757.              THEN RCV=0
  1758. '.pa
  1759.         IF RCV_
  1760.              THEN S$=MSGSUBJ$:_
  1761.                   GOSUB 3100:_                  'place s$ in random buffer
  1762.                   MID$(RR$,57)="1":_
  1763.                   PUT #1,SAVRC
  1764.  
  1765.         IF ML1 AND PAG=0_
  1766.              THEN 1602
  1767.  
  1768. 1850    IF CNTU=0_
  1769.              THEN CLOSE 1:_
  1770.                   GOTO 1620                     'read messages
  1771.  
  1772.         M=M+1
  1773.  
  1774.         IF M<=HIMSG_
  1775.              THEN 1690
  1776.  
  1777.         IF CNTU AND PAG_
  1778.              THEN LMSG=-1:_
  1779.                   GOTO 1723
  1780. 1870    CLOSE 1
  1781.         D1=0
  1782.         LST=0
  1783.         ML1=0
  1784.         NEWR=0
  1785.         NO$=""
  1786.         OLDR=0
  1787.         MGOT=0
  1788.         PAST=0
  1789.         RETURN
  1790. '.pa
  1791.         '** Prompt to scan messages
  1792.  
  1793.         'Variables:
  1794.         ' A$           = temporary string
  1795.         ' A1$          =
  1796.         ' B$           =
  1797.         ' CRLF$        = carriage return, line feed
  1798.         ' DATE$        = date
  1799.         ' HEADER       =
  1800.         ' G            =
  1801.         ' LOMSG        = low message read
  1802.         ' MSGSUBJ$     = message subject
  1803.         ' L            = line count
  1804.         ' LE$          =
  1805.         ' MSGNDX(n,n)  = message array index
  1806.         ' MKR          = marker number in help file
  1807.         ' MI           =
  1808.         ' M            =
  1809.         ' MZ           =
  1810.         ' NO$          =
  1811.         ' OK           =
  1812.         ' PAG          = page pause mode
  1813.         ' PERS$        =
  1814.         ' RE           = random record number
  1815.         ' S$           =
  1816.         ' SAV$         =
  1817.         ' MSGTO$       =
  1818.         ' HIMSG        = high message read
  1819.         ' XPR          = expert mode
  1820.  
  1821.  
  1822. 1880    MKR=6
  1823.         HEADER=-1
  1824.         A1$=CRLF$+"Msg # ("+MID$(STR$(LOMSG),2)+"-"+MID$(STR$(HIMSG),2)+")"
  1825.  
  1826.         IF XPR=0_
  1827.              THEN A1$=A1$+" to start? (C/R to end)"
  1828.  
  1829.         A1$=A1$+":"
  1830.         GOSUB 2660                              'print a$ or a1$
  1831.         GOSUB 2750                              'get command to b$
  1832.  
  1833.         IF LEN(B$)=0_
  1834.              THEN M=0_
  1835.              ELSE M=VAL(B$):_
  1836.                   GOSUB 2740                    'clear a$, n
  1837. '.pa
  1838. 1950    IF M<1_
  1839.              THEN RETURN
  1840.  
  1841.         IF M>HIMSG_
  1842.              THEN SAV$="":_
  1843.                   RETURN
  1844.  
  1845.         GOSUB 2640                              'print '^K to abort'
  1846.         PRINT
  1847.  
  1848. 1980    GOSUB 31000                     'get record number from index
  1849.         GOSUB 30030                             'open message file
  1850. 1990    GOSUB 3440                              'test for private message
  1851.  
  1852.         IF M>HIMSG_
  1853.            THEN 2160
  1854.  
  1855.         IF PAST THEN 2160
  1856.  
  1857.         IF OK=0 OR M=0_
  1858.              THEN 1990
  1859.  
  1860.         GET#1,RE+1
  1861.         GOSUB 30050                             'zero msg flags for display
  1862.         GOSUB 3110                              'clear trailing spaces
  1863.         DATE$=S$
  1864.  
  1865.         GET#1,RE+2
  1866.         GOSUB 30050                             'zero msg flags for display
  1867.         GOSUB 3110                              'clear trailing spaces
  1868.         NO$=S$
  1869.  
  1870.         GET#1,RE+3
  1871.         GOSUB 30050                             'zero msg flags for display
  1872.         GOSUB 3110                              'clear trailing spaces
  1873.         MSGTO$=S$
  1874.  
  1875.         GET#1,RE+4
  1876.         GOSUB 30050                             'zero msg flags for display
  1877.         GOSUB 3110                              'clear trailing spaces
  1878.         MSGSUBJ$=S$
  1879.  
  1880.         GET#1,RE+5
  1881.         GOSUB 3110                              'clear trailing spaces
  1882.         LE$=S$
  1883.  
  1884.         IF VAL(LE$)=0_
  1885.              THEN LE$=" F"
  1886.  
  1887.         IF LEFT$(NO$,3)<>"SYS"_
  1888.              THEN NO$=MID$(NO$,INSTR(NO$," ")+1)
  1889. '.pa
  1890.         IF MSGTO$<>"ALL" AND LEFT$(MSGTO$,3)<>"SYS"_
  1891.              THEN MSGTO$=MID$(MSGTO$,INSTR(MSGTO$," ")+1)
  1892.  
  1893.         IF HEADER_
  1894.              THEN HEADER=0:_
  1895.                   GOTO 2109
  1896.  
  1897.         IF LL MOD PAGLEN <> 0 OR PAG = 0_       'skip page pause
  1898.              THEN 2110
  1899.  
  1900.         GOSUB 21000                             '(more?)
  1901.         IF A$ = " "_
  1902.              THEN 2110
  1903.  
  1904.         IF BI=11 OR BI = 24_                    'user aborted
  1905.              THEN 2160
  1906.  
  1907.  
  1908. 2109    LL = 3
  1909.         PRINT CRLF$;STRING$(65,61);CRLF$;HEADER$;CRLF$;STRING$(65,45)
  1910.  
  1911. 2110    PRINT STR$(M);TAB(9);LEFT$(DATE$,8);TAB(20);NO$;TAB(34);_
  1912.               MSGTO$;" ";PERS$;TAB(48);MSGSUBJ$;" (";MID$(LE$,2);")"
  1913.  
  1914.         A$ = INKEY$
  1915.  
  1916. 2111    IF A$ <> ""_
  1917.              THEN BI = ASC(A$) AND 31_
  1918.              ELSE BI = 0
  1919.  
  1920.         IF BI = 11 OR BI = 24_                  'user aborted
  1921.              THEN 2160
  1922.  
  1923.         IF BI = 19_                             'user paused
  1924.              THEN A$ = INPUT$(1):_
  1925.                   GOTO 2111
  1926.  
  1927.         LL = LL + 1
  1928.         GOTO 1990
  1929.  
  1930. 2160    PRINT
  1931.         PAST=0
  1932.         CLOSE 1
  1933.         RETURN
  1934. '.pa
  1935.         '** Goodbye options
  1936.  
  1937.         'Variables:
  1938.         ' A1$          =
  1939.         ' B$           =
  1940.         ' CRLF$        = carriage return, line feed
  1941.         ' GB           = goodbye flag
  1942.         ' MSGSUBJ$     = message subject
  1943.         ' MKR          = marker number in help file
  1944.         ' MPW$         = message password
  1945.         ' MSGTO$       = message to:
  1946.         ' UID          =
  1947.         ' XPR          = expert mode
  1948.  
  1949. 2170    A1$=CRLF$+"Leave any comments? "
  1950.  
  1951.         IF XPR_
  1952.              THEN A1$=A1$+"(Y/N/R):"_
  1953.              ELSE A1$=A1$+CRLF$+"(Y)es/(N)o/(R)eturn to BBS:"
  1954.  
  1955.         GOSUB 2660                              'print a$ or a1$
  1956.         MKR=20
  1957.         GOSUB 2750                              'get command to b$
  1958.  
  1959.         IF LEFT$(B$,1)="R"_
  1960.              THEN RETURN
  1961.  
  1962.         IF LEFT$(B$,1)="Y"_
  1963.              THEN GB=-1:_
  1964.                   MSGTO$="SYSOP":_
  1965.                   MPW$=".READ.":_
  1966.                   MSGSUBJ$="Exit Comment":_
  1967.                   UID=1:_
  1968.                   GOTO 751
  1969.  
  1970. 2280    END
  1971. '.pa
  1972.         '** Kill a message
  1973.  
  1974.         'Variables:
  1975.         ' A1$          =
  1976.         ' B$           =
  1977.         ' BEL$         = bell
  1978.         ' CMSG$        = "Message"
  1979.         ' CRLF$        = carriage return, line feed
  1980.         ' DATE$        = date
  1981.         ' DEST$        =
  1982.         ' FL           =
  1983.         ' FROM$        =
  1984.         ' G            =
  1985.         ' I1$          =
  1986.         ' MSGSUBJ$     = message subject
  1987.         ' KIL          =
  1988.         ' KKIL         =
  1989.         ' KN           =
  1990.         ' M            =
  1991.         ' MSGNDX(n,n)  = message array index
  1992.         ' MI           =
  1993.         ' MKR          = marker number in help file
  1994.         ' MPW$         =
  1995.         ' MZ           =
  1996.         ' N$           = user's first name
  1997.         ' NA$          = user's full name
  1998.         ' O$           = user's last name
  1999.         ' OK           =
  2000.         ' PERS         =
  2001.         ' PW           =
  2002.         ' RE           = random record number
  2003.         ' RL           = random record length
  2004.         ' RR$          = contents of random record
  2005.         ' S$           =
  2006.         ' SPCL         = special user
  2007.         ' HIMSG        = high message read
  2008.         ' UF$          = user's access level
  2009.         ' UID          = user's id number
  2010.         ' WRTLOC       = write lock
  2011.  
  2012. 2290    IF INSTR("*MN",UF$)_
  2013.              THEN 8000
  2014.  
  2015.         A1$=CRLF$+CMSG$+" # to kill:"
  2016.         GOSUB 2660                              'print a$ or a1$
  2017.         MKR=5
  2018.         GOSUB 2750                              'get command to b$
  2019.  
  2020.         IF LEN(B$)=0_
  2021.              THEN M=0_
  2022.              ELSE M=VAL(B$)
  2023.  
  2024. 2310    IF M<1 OR M>HIMSG_
  2025.              THEN PRINT:_
  2026.                   RETURN
  2027.  
  2028.         GOSUB 31000                             'get message rec from index
  2029.         GOSUB 30030                             'open message file
  2030.         RL=65
  2031.  
  2032. 2330    GOSUB 3440                              'test for private message
  2033.  
  2034.         IF OK=0_
  2035.              THEN 2550
  2036.  
  2037.         GET#1,RE
  2038.         GOSUB 3110                              'clear trailing spaces
  2039.         PW=INSTR(S$,";")
  2040.         MPW$=MID$(S$,PW+1)
  2041.  
  2042.         GET#1,RE+1
  2043.         GOSUB 30050                             'zero msg flags for display
  2044.         GOSUB 3110                              'clear trailing spaces
  2045.         DATE$=S$
  2046.  
  2047.         IF UID=1_
  2048.              THEN FL=-1
  2049.  
  2050.         GET#1,RE+2
  2051.         GOSUB 30050                             'zero msg flags for display
  2052.         GOSUB 3110                              'clear trailing spaces
  2053.         FROM$=S$
  2054.  
  2055.         GET#1,RE+3
  2056.         GOSUB 30050                             'zero msg flags for display
  2057.         GOSUB 3110                              'clear trailing spaces
  2058.         DEST$=S$
  2059.  
  2060.         GET#1,RE+4
  2061.         GOSUB 30050                             'zero msg flags for display
  2062.         GOSUB 3110                              'clear trailing spaces
  2063.         MSGSUBJ$=S$
  2064.  
  2065.         IF KIL_
  2066.              THEN 2470_
  2067.              ELSE IF KKIL_
  2068.                        THEN 2400
  2069.  
  2070.         PRINT CRLF$;"MSG#:";STR$(M);"  DATE: ";DATE$
  2071.         PRINT"FROM: ";FROM$;"  TO: ";DEST$;"  SUBJ: ";MSGSUBJ$
  2072.  
  2073.         IF SPCL OR PERS_
  2074.              THEN PERS=0:_
  2075.                   GOTO 2400
  2076.  
  2077.         GET#1,RE+3
  2078.         NA$=N$+" "+O$
  2079.         GOSUB 3110                              'clear trailing spaces
  2080.  
  2081.         IF INSTR(S$,NA$)<>0_
  2082.              THEN 2470
  2083.  
  2084.         A1$=CRLF$+"Password?"
  2085.         GOSUB 2660                              'print a$ or a1$
  2086.         GOSUB 2750                              'get command to b$
  2087.  
  2088.         IF B$<>MPW$_
  2089.              THEN PRINT "Password incorrect.";BEL$:_
  2090.                   GOTO 2555
  2091.  
  2092. 2400    A1$="Kill this "+MSG$+"? (y/N):"
  2093.         GOSUB 2660                              'print a$ or a1$
  2094.         GOSUB 2750                              'get command to b$
  2095.  
  2096.         IF LEFT$(B$,1)<>"Y"_
  2097.              THEN PRINT CMSG$;" retained.":_
  2098.                   GOTO 2555
  2099.  
  2100. 2470    POKE WRTLOC,255
  2101.         S$="0"+";"+STR$(M)+":"+N$+" "+O$
  2102.         RL=65
  2103.         GOSUB 3100                              'place s$ in random buffer
  2104.  
  2105.         PUT #1,RE
  2106.         MSGNDX(1)=0
  2107.         CLOSE 1
  2108.         GOSUB 30010                             'open counter file
  2109.  
  2110.         GET#1,1
  2111.         LSET RR$=STR$(VAL(RR$)-1)
  2112.         PUT#1,1
  2113.         CLOSE 1
  2114.         GOSUB 30040                             'open index file
  2115.  
  2116.         FOR I=2 TO MZ
  2117.  
  2118.              GET #1,I
  2119.              KN=CVI(I1$)
  2120.  
  2121.              IF KN=M_
  2122.                   THEN LSET I1$=MKI$(0):_
  2123.                        PUT #1,I:_
  2124.                        I=MZ
  2125.  
  2126.         NEXT
  2127.  
  2128.         IF FL_
  2129.              THEN B$=MID$(STR$(M),2):_
  2130.                   NAME B$+".MF"+M1$ AS B$+".00"+M1$
  2131.  
  2132.         PRINT CMSG$;" killed."
  2133.         POKE WRTLOC,0
  2134.         GOTO 2555
  2135.  
  2136. 2550    PRINT CMSG$;" not found."
  2137.  
  2138. 2555    CLOSE 1
  2139.         KIL=0
  2140.         FL=0
  2141.         KKIL=0
  2142.         RETURN
  2143. '.pa
  2144.         '** Find User Record
  2145.         '    This is a dual purpose routine to find user:
  2146.         '    For 'I' command or for message entry
  2147.  
  2148.         'Variables:
  2149.         ' A1$          =
  2150.         ' A$           =
  2151.         ' BI           =
  2152.         ' CRLF$        = carriage return, line feed
  2153.         ' DEST$        =
  2154.         ' I            = loop counter
  2155.         ' MKR          = marker number in help file
  2156.         ' MSG          =
  2157.         ' MU$          =
  2158.         ' NN$          =
  2159.         ' NU           =
  2160.         ' RR$          = contents of random record
  2161.         ' S$           =
  2162.         ' SU$          =
  2163.         ' UID          = user's id number
  2164.         ' UF$          =
  2165.         ' ZZ           =
  2166.  
  2167. 2560    IF INSTR("*MN",UF$)_
  2168.              THEN 8000
  2169.  
  2170.         A1$=CRLF$+"Find which user? (C/R=all):"
  2171.         GOSUB 2660                              'print a$ or a1$
  2172.  
  2173.         MKR=21
  2174.         GOSUB 2750                              'get command to b$
  2175.         GOSUB 2640                              'print '^K to abort'
  2176.  
  2177. 2570    GOSUB 30020                             'open users file
  2178.         FIELD#1,1 AS MU$,1 AS SU$,76 AS RR$
  2179.         FIELD#1,10 AS NN$
  2180.  
  2181.         GET#1,1
  2182.         NU=VAL(NN$)
  2183.  
  2184.         FOR I=2 TO NU
  2185.  
  2186.              GET#1,I
  2187.  
  2188.              IF (INSTR("*0",MU$)) AND MSG=0_
  2189.                   THEN 2620                     'continue search loop
  2190.  
  2191.              IF MU$ = "0" AND MSG = 2_
  2192.                   THEN 2620                     'continue search loop
  2193.  
  2194.              GOSUB 3110                         'clear trailing spaces
  2195.              A$=LEFT$(S$,40)
  2196.  
  2197.              IF INSTR(A$,B$)=0_
  2198.                   THEN 2620
  2199.  
  2200.              ZZ=LEN(A$)
  2201.  
  2202.              WHILE MID$(A$,ZZ,1)=" "
  2203.                   ZZ=ZZ-1
  2204.              WEND
  2205.  
  2206.              A$=LEFT$(A$,ZZ)
  2207.              DEST$=A$
  2208.  
  2209.              IF MSG=2_
  2210.                   THEN UID=I:_
  2211.                        GOTO 2630_
  2212.                   ELSE GOSUB 2660               'print a$ or a1$
  2213.  
  2214.              IF BI=11 OR BI=24_                 'abort with ^K/K/k/^X/X/x
  2215.                   THEN 2630
  2216.  
  2217. 2620    NEXT I
  2218.  
  2219. 2630    CLOSE 1
  2220.         RETURN
  2221. '.pa
  2222.         '** Print A$ or A1$ string
  2223.  
  2224.         'Variables:
  2225.         ' A$           =
  2226.         ' A1$          =
  2227.         ' BI           =
  2228.         ' CRLF$        = carriage return, line feed
  2229.         ' LST          = line printer flag
  2230.         ' N            =
  2231.         ' PP$          =
  2232.         ' SAV$         =
  2233.         ' XPR          = expert mode
  2234.  
  2235. 2640    IF XPR_
  2236.              THEN 2660                          'print a$ or a1$
  2237.  
  2238. 2650    A$=CRLF$+"Enter ^K,K,k to abort, ^S,S,s to pause."
  2239.  
  2240. 2660    BI=0
  2241.  
  2242.         IF SAV$<>"" AND A1$<>""_
  2243.              THEN A1$="":_
  2244.              RETURN
  2245.  
  2246.         IF A1$<>""_
  2247.              THEN A$=A1$:_
  2248.                   A1$=""
  2249.  
  2250.         IF (RIGHT$(A$,1)="?" OR RIGHT$(A$,1)=":" OR N=1)_
  2251.            AND INLINE_
  2252.              THEN PRINT A$;" ";:_
  2253.                   PP$=A$:_
  2254.                   GOTO 2740                     'clear a$, n, and return
  2255.  
  2256.         A1$=INKEY$:_
  2257.  
  2258.         IF A1$<>"" _
  2259.              THEN BI=ASC(A1$)
  2260.  
  2261. 2700    BI = BI AND 31
  2262.  
  2263.         IF BI=19_                               'pause with ^S/S/s
  2264.              THEN BI=ASC(INPUT$(1)):_
  2265.                   GOTO 2700
  2266.  
  2267.         IF BI=11 OR BI = 24_                    'abort with ^K/K/k/^X/X/x
  2268.              THEN PRINT:_
  2269.                   GOTO 2740                     'clear a$, n, and return
  2270.  
  2271.         PRINT A$
  2272. '.pa
  2273.         IF LST_
  2274.              THEN LPRINT A$
  2275.  
  2276. 2740    A$=""
  2277.         A1$=""
  2278.         N=0
  2279.         RETURN
  2280.  
  2281.  
  2282.         '** Get commands from B$, check if stacked
  2283.  
  2284.         'Variables:
  2285.         ' B$           =
  2286.         ' CAPS         = capitalization flag
  2287.         ' SAV$         =
  2288.         ' SP           = pointer
  2289.  
  2290. 2750    B$=""
  2291.  
  2292.         IF SAV$=""_
  2293.              THEN GOSUB 3500                    'process input character
  2294.  
  2295.         SP=INSTR(SAV$,";")
  2296.  
  2297.         IF SP=0_
  2298.              THEN B$=SAV$:_
  2299.                   SAV$="":_
  2300.                   GOTO 2800
  2301.  
  2302.         B$=LEFT$(SAV$,SP-1)
  2303.         SAV$=MID$(SAV$,SP+1)
  2304.  
  2305. 2800    IF B$ =""_
  2306.              THEN RETURN
  2307.  
  2308.         IF CAPS=0_
  2309.              THEN 2890
  2310.  
  2311.         CALL UCASE(B$)                          'capitalize b$
  2312.  
  2313.         '   delete leading spaces from B$
  2314. 2890    ZZ = 1
  2315.         WHILE MID$(B$,ZZ,1) = " " AND ZZ < LEN(B$)
  2316.              ZZ = ZZ + 1
  2317.         WEND
  2318.         B$ = MID$(B$,ZZ)
  2319.         CAPS = 1
  2320.  
  2321.         RETURN
  2322. '.pa
  2323.         '** Error handler
  2324.  
  2325.         'Variables
  2326.         ' CAPS         = capitalization flag
  2327.         ' DUP          =
  2328.         ' ERL          = error line (reserved variable)
  2329.         ' ERR          = error number (reserved variable)
  2330.         ' FL           =
  2331.         ' HIMSG        = high message read
  2332.  
  2333. 2900    RESUME 2901
  2334.  
  2335. 2901    IF ERL=3250_                            'display text file
  2336.              THEN FL=0:_
  2337.                   GOTO 3300
  2338.  
  2339.         CLOSE
  2340.  
  2341.         IF ERL=260_
  2342.              THEN HIMSG=0:_
  2343.                   GOTO 280
  2344.  
  2345.         IF ERL=1510_
  2346.              THEN CAPS=0:_
  2347.                   GOTO 1520
  2348.  
  2349.         PRINT"Error";ERR;"occured on line";ERL
  2350.  
  2351.         DUP=-1
  2352.         GOTO 520
  2353. '.pa
  2354.         '** Print user stats, prompt for new password
  2355.  
  2356.         'Variables:
  2357.         ' A$           =
  2358.         ' ATO          = auto message read mode
  2359.         ' B$           =
  2360.         ' HOMEBASE$    = User's home message base
  2361.         ' CRLF$        = carriage return, line feed
  2362.         ' I            = loop counter
  2363.         ' LON$         = last on date
  2364.         ' M1$          = message base number
  2365.         ' MKR          = marker number in help file
  2366.         ' N$           = user's first name
  2367.         ' NN           =
  2368.         ' NN$          =
  2369.         ' NU           =
  2370.         ' NULLS        = number of nulls
  2371.         ' O$           = user's last name
  2372.         ' PAG          = page pause mode
  2373.         ' PW$          = user's password
  2374.         ' RR$          = contents of random record
  2375.         ' SAV$         =
  2376.         ' ST$          = user's state
  2377.         ' UF$          = user's access level
  2378.         ' UP$          = user's parameters
  2379.         ' UR           = user id number
  2380.         ' UR$          = user id number
  2381.         ' XPR          = expert user mode
  2382.         ' WRTLOC       = write lock
  2383.  
  2384. 2950    I=VAL(UR$)
  2385.         PRINT CRLF$;"Your USER ID# is";I
  2386.         NN=PEEK(NULLS)
  2387.         PRINT MID$(STR$(NN),2); " nulls"
  2388.         PRINT "Auto-Read";MODE$;" is ";
  2389.  
  2390.         IF ATO_
  2391.              THEN PRINT"on."_
  2392.              ELSE PRINT"off."
  2393.  
  2394.         IF XPR_
  2395.              THEN PRINT"Expert";_
  2396.              ELSE PRINT"Novice";
  2397.  
  2398.         PRINT MODE$;" is on."
  2399.         PRINT "Page pause";MODE$;" is ";
  2400.  
  2401.         IF PAG_
  2402.              THEN PRINT "on."_
  2403.              ELSE PRINT "off."
  2404. '.pa
  2405.         IF HOMEBASE$<>"W"_
  2406.              THEN PRINT "Home base is file # ";HOMEBASE$
  2407.  
  2408. 3020    NN$=STR$(NN)
  2409.         UP$=RIGHT$(NN$,1)
  2410.  
  2411.         IF XPR_
  2412.              THEN UP$=UP$+"X"_
  2413.              ELSE UP$=UP$+"x"
  2414.  
  2415.         IF ATO_
  2416.              THEN UP$=UP$+"P"_
  2417.              ELSE UP$=UP$+"p"
  2418.  
  2419.         IF PAG_
  2420.              THEN UP$=UP$+"T"_
  2421.              ELSE UP$=UP$+"t"
  2422.  
  2423.         UP$=UP$+HOMEBASE$
  2424.         UP$=RIGHT$(UP$,5)
  2425.         B$=M1$
  2426.         M1$="1"
  2427.         GOSUB 30020
  2428.         FIELD#1,78 AS RR$
  2429.         M1$=B$
  2430.         GET #1,I
  2431.  
  2432. 3060    PW$=MID$(RR$,51,4)
  2433.         PRINT "Your password is ";PW$
  2434.         A$="Enter new password (C/R=same):"
  2435.         MKR=15
  2436.         GOSUB 2660
  2437.         GOSUB 2750
  2438.  
  2439.         IF LEN(B$)=0_
  2440.              THEN 3090
  2441.  
  2442.         IF LEN(B$)<>4_
  2443.              THEN 3060_
  2444.              ELSE PW$=B$
  2445.  
  2446. 3090    POKE WRTLOC,255
  2447.         MID$(RR$,46,9)=UP$+PW$
  2448.         PUT #1,I
  2449.         CLOSE 1
  2450.         POKE WRTLOC,0
  2451.         A$="O"
  2452.         GOSUB 30015
  2453.         WRITE #1,N$,O$,UF$,UR$,PW$,ST$,UP$,LON$
  2454.         CLOSE 1
  2455.         RETURN
  2456. '.pa
  2457.         '** Fill with spaces and place in random buffer
  2458.  
  2459.         'Variables:
  2460.         ' CRLF$        = carriage return, line feed
  2461.         ' RL           = length of random record
  2462.         ' RR$          = contents of random record
  2463.         ' S$           =
  2464.  
  2465. 3100    LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CRLF$
  2466.         RETURN
  2467.  
  2468.  
  2469.  
  2470.         '** Clear trailing spaces
  2471.  
  2472.         'Variables:
  2473.         ' RR$          = contents of random record
  2474.         ' ZZ           =
  2475.         ' S$           =
  2476.  
  2477. 3110    ZZ=LEN(RR$)-2
  2478.         WHILE MID$(RR$,ZZ,1)=" " AND ZZ>1
  2479.              ZZ=ZZ-1
  2480.         WEND
  2481.  
  2482. 3130    S$=LEFT$(RR$,ZZ)
  2483.  
  2484.         IF RIGHT$(S$,1)="?"_
  2485.              THEN S$=S$+" "
  2486.  
  2487.         RETURN
  2488. '.pa
  2489.         '** Change user parameters
  2490.  
  2491.         'Variables:
  2492.         ' A1$          =
  2493.         ' ATO          = auto message read mode
  2494.         ' B$           =
  2495.         ' HOMEBASE$    = User's home message base
  2496.         ' CRLF$        = carriage return, line feed
  2497.         ' MKR          = marker number in help file
  2498.         ' NULLS        = number of nulls
  2499.         ' PAG          = page pause mode
  2500.         ' XPR          = expert user mode
  2501.  
  2502. 3150    A1$=CRLF$+"Enter number of nulls (0-9):"
  2503.         GOSUB 2660                              'print a$ or a1$
  2504.         MKR=10
  2505.         GOSUB 2750                              'get command to b$
  2506.  
  2507.         IF B$=""_
  2508.              THEN RETURN
  2509.  
  2510.         IF VAL(B$)<0 OR VAL(B$)>9_
  2511.              THEN 3150                          'set nulls
  2512.  
  2513.         POKE NULLS,VAL(B$)
  2514.         RETURN
  2515.  
  2516. 3170    XPR=NOT(XPR)
  2517.         PRINT
  2518.  
  2519.         IF XPR_
  2520.              THEN PRINT "Expert";MODE$_
  2521.              ELSE PRINT "Novice";MODE$
  2522.         RETURN
  2523.  
  2524. 3190    ATO=NOT(ATO)
  2525.         PRINT CMGS$;"Auto-Read";MODE$;" is ";
  2526.  
  2527.         IF ATO_
  2528.              THEN PRINT "on."_
  2529.              ELSE PRINT "off."
  2530.  
  2531.         RETURN
  2532.  
  2533. 3204    PAG=NOT(PAG)
  2534.         PRINT "Page Pause";MODE$;" is ";
  2535.  
  2536.         IF PAG_
  2537.              THEN PRINT "on."_
  2538.              ELSE PRINT "off."
  2539.  
  2540.         RETURN
  2541.  
  2542. 3208    A1$=CRLF$+"Enter home base file number:"
  2543.         GOSUB 2660                              'print a$ or a1$
  2544.         MKR=11
  2545.         GOSUB 2750                              'get command to b$
  2546.  
  2547.         IF B$=""_
  2548.              THEN RETURN
  2549.  
  2550.         IF VAL(B$)<0 OR VAL(B$)>6_
  2551.              THEN 3208                          'set home base
  2552.  
  2553.         IF B$= "0"_
  2554.              THEN B$ = "W"
  2555.  
  2556.         HOMEBASE$=B$
  2557.  
  2558.         RETURN
  2559. '.pa
  2560.         '** Display a text file
  2561.  
  2562.         'Variables:
  2563.         ' A$           =
  2564.         ' B1$          =
  2565.         ' BI           =
  2566.         ' DRIVES$      = drive assignment
  2567.         ' FIL$         = file name to print
  2568.         ' L            = lines printed (page pause)
  2569.         ' PAG          = page pause mode
  2570.  
  2571. 3250    OPEN "I",2,DRIVE$+FIL$
  2572.         INLINE = 0                              'allows trailing : or ?
  2573.         IF FL = -1_                             'use with (more?) pause
  2574.              THEN LL = 6_
  2575.              ELSE LL = 1
  2576.  
  2577. 3260    IF EOF(2)_
  2578.              THEN 3300
  2579.  
  2580.         LINE INPUT #2,A$
  2581.  
  2582.         IF LEFT$(A$,4)="----" AND DASHFILE_
  2583.              THEN IF NOT(FIRSTPAGE)_
  2584.                        THEN WHILE LL < PAGLEN - 1:_
  2585.                             PRINT:_
  2586.                             LL = LL + 1:_
  2587.                        WEND:_
  2588.                   ELSE FIRSTPAGE = 0_
  2589.              ELSE GOSUB 2660
  2590.  
  2591.         LL = LL + 1
  2592.         IF LL MOD PAGLEN = 0 AND PAG <> 0_
  2593.              THEN GOSUB 21000                   '(more?)
  2594.  
  2595.         IF BI = 11 OR BI = 24_                  'abort with ^K/K/k/^X/X/x
  2596.              THEN 3300
  2597.  
  2598.         GOTO 3260
  2599.  
  2600. 3300    FIRSTPAGE = -1
  2601.         INLINE = -1
  2602.         DASHFILE = 0
  2603.         CLOSE 2
  2604.         RETURN
  2605.  
  2606. '.pa
  2607.         '** Test for private message
  2608.  
  2609.         'Variables:
  2610.         ' N$           = user's first name
  2611.         ' O$           = user's last name
  2612.         ' OK           =
  2613.         ' PERS         =
  2614.         ' PERS$        =
  2615.         ' RE           = random record number
  2616.         ' RR$          = contents of random record
  2617.         ' SPCL         = special user
  2618.         ' UN$          =
  2619.         ' UO$          =
  2620.         ' ZN$          =
  2621.         ' Z0$          =
  2622.  
  2623. 3440    PERS$=""
  2624.         PERS=0
  2625.         OK=-1
  2626.  
  2627.         IF MRE>=MX THEN PAST=-1:RETURN
  2628.         GET #1,MRE
  2629.         M=VAL(RR$)
  2630.         RE=MRE
  2631.         TEMP$=RR$
  2632.         GET #1,RE+5:MRE=RE+VAL(RR$)+6
  2633.         IF INSTR(TEMP$,";.READ.")=0_
  2634.              THEN RETURN
  2635.         PERS$="*"
  2636.         PERS=-1
  2637.  
  2638.         IF SPCL THEN_
  2639.              RETURN
  2640.  
  2641.         GET #1,RE+3
  2642.  
  2643.         ZN$=UN$
  2644.         ZO$=UO$
  2645.         GOSUB 3480                              'set ok flag
  2646.  
  2647.         IF OK_
  2648.              THEN RETURN
  2649.  
  2650.         GET #1,RE+2
  2651.         ZN$=N$
  2652.         ZO$=O$
  2653.         GOSUB 3480                              'set ok flag
  2654.  
  2655.         RETURN
  2656. '.pa
  2657. 3480    IF INSTR(RR$,ZN$)>0 AND INSTR(RR$,ZO$)>0_
  2658.              THEN OK=-1_
  2659.              ELSE OK=0
  2660.         RETURN
  2661. '.pa
  2662.         '** Process each character input
  2663.  
  2664.         'Variables:
  2665.         ' BEL$         = bell
  2666.         ' CHC          =
  2667.         ' DUP          =
  2668.         ' ERS$         = eraseable backspace
  2669.         ' F            = line number in message
  2670.         ' INS          =
  2671.         ' KEY          =
  2672.         ' MKR          = marker number in help file
  2673.         ' NCH          =
  2674.         ' SAV$         =
  2675.  
  2676. 3500    CHC=0
  2677.         SAV$=""
  2678.  
  2679. 3510    NCH=ASC(INPUT$(1))
  2680.  
  2681.         IF NCH<32 OR NCH=127_
  2682.              THEN 3590
  2683.  
  2684.         IF NCH=63 AND CHC=0 AND MKR>0_
  2685.              THEN PRINT:_
  2686.                   GOTO 13000
  2687.  
  2688.         IF CHC=63 AND INS AND KEY_
  2689.              THEN 3530
  2690.  
  2691.         IF CHC=63 AND NCH=32 AND KEY_
  2692.              THEN PRINT:_
  2693.                   CHC=0:_
  2694.                   RETURN
  2695.  
  2696.         IF CHC=63 AND NCH<>32 AND KEY_
  2697.              THEN SAV$=SAV$+CHR$(NCH):_
  2698.                   GOSUB 30000:_                 'word wrap
  2699.                   RETURN
  2700.  
  2701. 3530    IF CHC=63_
  2702.              THEN PRINT BEL$;:_
  2703.                   GOTO 3510                     'process character input
  2704.  
  2705.         SAV$=SAV$+CHR$(NCH)
  2706.         CHC=CHC+1
  2707.  
  2708.         IF DUP_
  2709.              THEN PRINT CHR$(NCH);
  2710.  
  2711.         GOTO 3510                               'process character input
  2712. '.pa
  2713. 3570    IF CHC=0_
  2714.              THEN 3510_                         'process character input
  2715.              ELSE PRINT ERS$;
  2716.  
  2717. 3580    IF CHC=0_
  2718.              THEN 3510_                         'process character input
  2719.              ELSE CHC=CHC-1:_
  2720.                   SAV$=LEFT$(SAV$,CHC):_
  2721.                   GOTO 3510                     'process character input
  2722.  
  2723.  
  2724.         '** Process control characters
  2725.  
  2726.         'Variables:
  2727.         ' BCC          = loop counter
  2728.         ' CHC          =
  2729.         ' DUP          =
  2730.         ' ERS$         = eraseable backspace
  2731.         ' NCH          =
  2732.         ' SAV$         =
  2733.         ' TP           =
  2734.  
  2735. 3590    IF NCH=127_
  2736.              THEN NCH=8
  2737.  
  2738.         IF NCH=8 AND DUP_
  2739.              THEN 3570
  2740.  
  2741.         IF NCH=4_
  2742.              THEN DUP=NOT(DUP)
  2743.  
  2744.         IF NCH=8_
  2745.              THEN 3580
  2746.  
  2747.         IF NCH=9_
  2748.              THEN IF DUP_
  2749.                        THEN 3770_
  2750.                        ELSE PRINT CHR$(NCH);:_
  2751.                             GOTO 3510           'process character input
  2752.  
  2753.         IF NCH=13_
  2754.              THEN PRINT:_
  2755.                   RETURN
  2756.  
  2757.         IF NCH<>24 OR CHC=0_
  2758.              THEN 3510                          'process character input
  2759.  
  2760.         FOR BCC=1 TO CHC
  2761.              PRINT ERS$;
  2762.         NEXT BCC
  2763.  
  2764.         GOTO 3500
  2765.  
  2766. 3770    TP=(CHC AND 248)+8-CHC
  2767.         PRINT SPACE$(TP);
  2768.         SAV$=SAV$+SPACE$(TP)
  2769.         CHC=CHC+TP
  2770.  
  2771.         GOTO 3510                               'process character input
  2772.         RETURN
  2773.  
  2774.         '** Clear trailing spaces
  2775.  
  2776.         'Variables:
  2777.         ' TEMP$        =
  2778.  
  2779. 4390    IF RIGHT$(TEMP$,1)=" "_
  2780.              THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):_
  2781.                   GOTO 4390
  2782.         RETURN
  2783.  
  2784.  
  2785.         '** Pass NEW MESSAGE string to B$
  2786.  
  2787.         'Variables:
  2788.         ' A$           =
  2789.         ' B$           =
  2790.         ' D1           =
  2791.         ' LM           =
  2792.         ' M            =
  2793.  
  2794. 6000    D1=-1
  2795.         M=LM+1
  2796.         B$=STR$(M)+"+"
  2797.         A$=""
  2798.         GOTO 1650
  2799.  
  2800.  
  2801.  
  2802.         '** Insufficient access for requested function.
  2803.  
  2804.         'Variables:
  2805.         ' CRLF$        = Carriage return, line feed
  2806.  
  2807. 8000    PRINT CRLF$;"Sorry, insufficient access."
  2808.         RETURN
  2809. '.pa
  2810.         '** Show version of QRUN that we are running.
  2811.  
  2812.         'Variables:
  2813.         ' VERS$        = version
  2814.  
  2815. 8100    PRINT CRLF$;"Current software revision is: ";VERS$;CRLF$
  2816.         RETURN
  2817.  
  2818.  
  2819.         '** Direct move to a message file selected with 1-6.
  2820.         'Variables:
  2821.         'MFILE$         = message file name
  2822.         'UF$            = user access level
  2823.         'B$             =
  2824.         'M1$            = message file
  2825.  
  2826. 8900    IF MFILE$(VAL(B$)) = " "_
  2827.              THEN 580
  2828.  
  2829.         IF B$ = "6"_
  2830.              THEN IF INSTR("+$S",UF$)_
  2831.                        THEN M1$ = B$:_
  2832.                             GOTO 8910_
  2833.                        ELSE 580
  2834.  
  2835. 8910    M1$ = B$
  2836.         GOTO 9020
  2837.  
  2838. '.pa
  2839.         '** Move up or down one message base ('>', '<' commands)
  2840.  
  2841.         'Variables:
  2842.         ' CRLF$        = Carriage return, line feed
  2843.         ' M1$          = Message base number
  2844.         ' TM$          = Stores M1$ - TR MOD
  2845.         ' MFILE$(n)    = Name of message base
  2846.         ' UF$          = User access level
  2847.         ' SPCL         = Special User
  2848. 9000    TM$=M1$
  2849. 9005    IF M1$="6"_
  2850.            THEN 9030
  2851.  
  2852.         M1$=MID$(STR$(VAL(M1$)+1),2)
  2853.  
  2854.  
  2855.         IF INSTR("+$S",UF$)=0 AND M1$="6"_
  2856.              THEN 9030
  2857.         IF MFILE$(VAL(M1$))=" "_
  2858.              THEN 9005
  2859.  
  2860.         GOTO 9020
  2861.  
  2862. 9010    TM$=M1$
  2863. 9015    IF M1$="1"_
  2864.              THEN 9030
  2865.  
  2866.         M1$=MID$(STR$(VAL(M1$)-1),2)
  2867.  
  2868.         IF MFILE$(VAL(M1$))=" "_
  2869.              THEN 9015
  2870.  
  2871. 9020    PRINT CRLF$;"Moving to ";MFILE$(VAL(M1$))
  2872.         GOTO 10020
  2873.  
  2874. 9030    M1$=TM$:_
  2875.         RETURN
  2876.  
  2877. '.pa
  2878.         '** Choose a message file
  2879.  
  2880.         'Variables:
  2881.         ' A1$          = temporary string to print
  2882.         ' B$           = User input (from subroutine)
  2883.         ' CMSG$        = "Message"
  2884.         ' CRLF$        = Carriage return, line feed
  2885.         ' D1           =
  2886.         ' FIL$         = File name to print
  2887.         ' FPW$         =
  2888.         ' I            = loop counter
  2889.         ' LON$         = Last On
  2890.         ' M1$          = Message base number
  2891.         ' MFG          =
  2892.         ' MFILE$(n)    = Name of message base
  2893.         ' MKR          = marker number in help file
  2894.         ' ML1$         =
  2895.         ' PW$          = user's password
  2896.         ' SPCL         = Special User
  2897.         ' UF$          = User access level
  2898.  
  2899.        '** Choose a message file
  2900. 10000    IF M1$="1" AND LON$="--"_
  2901.              THEN 10030
  2902.  
  2903.          MFG=0
  2904.          A1$=CRLF$+CMSG$+" files are:"+CRLF$+CRLF$
  2905.  
  2906.          FOR I=1 TO 5
  2907.              IF MFILE$(I)<>" "_
  2908.              THEN A1$=A1$+STR$(I)+" "+MFILE$(I)+CRLF$
  2909.          NEXT I
  2910.  
  2911.          IF INSTR("+$S",UF$)_
  2912.              THEN A1$=A1$+" 6 "+MFILE$(6)+CRLF$
  2913.  
  2914. 10010   A1$=A1$+CRLF$+"Select file (RETURN for Descriptions):"
  2915.         GOSUB 2660                              'print a$ or a1$
  2916.         MKR=7
  2917.         GOSUB 2750                              'get command to b$
  2918.  
  2919.         IF B$=""_
  2920.              THEN FIL$="FILE-DES":_
  2921.                   GOSUB 3250:_                  'display text file
  2922.                   GOTO 10000
  2923.  
  2924.         IF LEN(B$)>1_
  2925.              THEN 10010
  2926.  
  2927.         M1$=B$
  2928. '.pa
  2929.         IF VAL(M1$)<1 OR VAL(M1$)>6_
  2930.              THEN 10010
  2931.  
  2932. 10020   IF M1$<"6"_
  2933.              THEN MFILE$=MFILE$(VAL(M1$))
  2934.  
  2935.         IF INSTR("+$S",UF$) AND M1$="6"_
  2936.              THEN MFILE$=MFILE$(6)_
  2937.              ELSE IF M1$="6"_
  2938.                        THEN 10010
  2939.  
  2940. 10030   IF MFILE$=" "_
  2941.              THEN 10000
  2942.         D1=-1
  2943.         ML1$=""
  2944.         FPW$=PW$
  2945. '.pa
  2946.         '** Login to new message file
  2947.  
  2948.         'Variables:
  2949.         ' B$           =
  2950.         ' CN!          = caller number
  2951.         ' DATE$        = date
  2952.         ' D1           = counter
  2953.         ' FPW$         =
  2954.         ' I            = loop counter
  2955.         ' LM           =
  2956.         ' LM$          =
  2957.         ' LON$         = last on date
  2958.         ' M            =
  2959.         ' M$           =
  2960.         ' N$           = user's first name
  2961.         ' NA$          =
  2962.         ' NN$          =
  2963.         ' NU           =
  2964.         ' O$           = user's last name
  2965.         ' PW$          = user's password
  2966.         ' QQ           =
  2967.         ' QR           =
  2968.         ' RL           = random record length
  2969.         ' RR$          = contents of random record
  2970.         ' S$           =
  2971.         ' ST$          = user's state
  2972.         ' UF$          = user's access level
  2973.         ' UP$          = user's parameters
  2974.         ' HIMSG        = high message read
  2975.         ' UR           =
  2976.         ' UU$          =
  2977.         ' URF          =
  2978.         ' V            =
  2979.         ' WRTLOC       = write lock
  2980.  
  2981.         GOSUB 20000                             'get and format date
  2982.         GOSUB 30010                             'open counter file
  2983.  
  2984.         D1=0                                    '** COUNTER
  2985.  
  2986.         GET#1,1
  2987.         M=VAL(RR$)
  2988.  
  2989.         GET#1,2
  2990.         CN!=VAL(RR$)+1                          'increment caller number
  2991.  
  2992.         LSET RR$=MID$(STR$(CN!),2)              'and save it to disk
  2993.  
  2994.         PUT#1,2
  2995. '.pa
  2996.         GET#1,3
  2997.         HIMSG=VAL(RR$)
  2998.         CLOSE 1
  2999.         UU$=RIGHT$("000"+MID$(STR$(HIMSG),2),4)
  3000.         NA$=N$+" "+O$
  3001.         URF=0
  3002.         V=0
  3003.         RL=78
  3004.         GOSUB 30020
  3005.         FIELD#1,78 AS RR$
  3006.         POKE WRTLOC,255
  3007.  
  3008.         GET#1,1
  3009.         NU=VAL(RR$)
  3010.  
  3011.         FOR I=2 TO NU+1
  3012.              GET#1,I
  3013.              B$=LEFT$(RR$,44)
  3014.              M$=LEFT$(RR$,1):
  3015.  
  3016.              IF M$="0"_
  3017.                   THEN UR=I:_
  3018.                        URF=-1:_
  3019.                        GOTO 10040
  3020.  
  3021.              IF INSTR(B$,NA$)=0_
  3022.                   THEN 10040
  3023.  
  3024.              NN$=MID$(RR$,3)
  3025.              QQ=INSTR(NN$," ")
  3026.              N$=LEFT$(NN$,QQ-1)
  3027.              NN$=MID$(NN$,QQ+1)
  3028.              QQ=INSTR(NN$," from")
  3029.              O$=LEFT$(NN$,QQ-1)
  3030.              NN$=MID$(NN$,QQ+6)
  3031.              QR=INSTR(NN$,"  ")
  3032.              ST$=LEFT$(NN$,QR-1)
  3033.              UF$=LEFT$(RR$,1)
  3034.  
  3035.              IF M1$="1" THEN _
  3036.                 UP$=MID$(RR$,46,5) : _
  3037.                     PW$=MID$(RR$,51,4)
  3038.  
  3039.              LM$=MID$(RR$,55,4)
  3040.              MID$(RR$,55,4)=UU$
  3041.              LON$=MID$(RR$,59,17)
  3042.              MID$(RR$,59,17)=DATE$
  3043.              PUT #1,I
  3044.  
  3045.              CLOSE 1
  3046. '.pa
  3047.              UR=I
  3048.              LM=VAL(LM$)
  3049.              GOTO 10050
  3050.  
  3051. 10040   NEXT I
  3052.  
  3053.         M$=UF$
  3054.         UP$="0xPTW"
  3055.         S$=M$+" "+N$+" "+O$+" from "+ST$
  3056.  
  3057.         RL=78
  3058.         GOSUB 3100                              'place s$ in random buffer
  3059.  
  3060.         MID$(RR$,46,5)=UP$
  3061.         MID$(RR$,51,4)=FPW$
  3062.         MID$(RR$,55,4)=UU$
  3063.         MID$(RR$,59,17)=DATE$
  3064.  
  3065.         IF URF_
  3066.              THEN PUT #1,UR_
  3067.              ELSE NU=NU+1:_
  3068.                   PUT#1,NU:_
  3069.                   UR=NU
  3070.  
  3071.         IF M1$="1"_
  3072.              THEN UR$=STR$(UR)                  '** ADDED
  3073.  
  3074.         S$=STR$(NU)
  3075.         GOSUB 3100                              'place s$ in random buffer
  3076.         PUT#1,1
  3077.         CLOSE 1
  3078.  
  3079.         LON$="--"
  3080.         UF$=M$
  3081.  
  3082. 10050   GOSUB 30060                             'check for sysop, set flag
  3083. '.pa
  3084.         '** Write callers file, bypass for $SYSOP
  3085.  
  3086.         'Variables:
  3087.         ' DATE$        = date
  3088.         ' DRIVE$       = drive assignment
  3089.         ' M1$          = message base number
  3090.         ' N$           = user's first name
  3091.         ' O$           = user's last name
  3092.         ' RE           =
  3093.         ' RL           = random record length
  3094.         ' RR$          = contents of random record
  3095.         ' S$           =
  3096.         ' ST$          = user's state
  3097.         ' UF$          = user's access level
  3098.         ' WRTLOC       = write lock
  3099.  
  3100.         IF UF$="$"_
  3101.              THEN POKE WRTLOC,0:_
  3102.                   GOTO 280
  3103.  
  3104.         OPEN "R",1,DRIVE$+"CALLERS"+M1$,65
  3105.         FIELD#1,65 AS RR$
  3106.  
  3107.         GET#1,1
  3108.  
  3109.         RE=VAL(RR$)+1
  3110.         S$=STR$(RE)
  3111.         RL=65
  3112.         GOSUB 3100                              'place s$ in random buffer
  3113.         PUT#1,1
  3114.  
  3115.         RE=RE+1
  3116.         S$=N$+" "+O$+" from "+ST$+" "+DATE$+" ("+STR$(PEEK(&H3C))+")"
  3117.         GOSUB 3100                              'place s$ in random buffer
  3118.         PUT#1,RE
  3119.  
  3120.         CLOSE 1
  3121.  
  3122.         POKE WRTLOC,0
  3123.  
  3124.         GOTO 280
  3125. '.pa
  3126.         '** Print callers file
  3127.  
  3128.         'Variables:
  3129.         ' A$           =
  3130.         ' BI           = character input
  3131.         ' CRLF$        = carriage return, line feed
  3132.         ' I            = loop counter
  3133.         ' M1$          = message base number
  3134.         ' RR$          = contents of random file record
  3135.         ' S$           =
  3136.         ' UF$          = user access
  3137.         ' ZZ           = temporary integer
  3138.  
  3139. 12000   IF INSTR("+$S",UF$)=0_
  3140.              THEN RETURN
  3141.  
  3142.         PRINT CRLF$
  3143.         OPEN "R",1,DRIVE$+"CALLERS"+M1$,65
  3144.         FIELD #1,65 AS RR$
  3145.         GET #1,1
  3146.         ZZ=VAL(RR$)
  3147.  
  3148.         FOR I=ZZ+1 TO 2 STEP -1
  3149.  
  3150.              GET #1,I
  3151.              GOSUB 3110                         'clear trailing spaces
  3152.              A$=S$
  3153.              GOSUB 2660                         'print a$ or a1$
  3154.  
  3155.              IF BI=11_                          '^K abort display
  3156.                   THEN I=2
  3157.  
  3158.         NEXT I
  3159.  
  3160.         CLOSE 1
  3161.         RETURN
  3162.  
  3163. '.pa
  3164.         '** Process help markers.  MKR=marker number in help file
  3165.  
  3166.         'Variables:
  3167.         ' B$           =
  3168.         ' DRIVE$       = drive assignment
  3169.         ' FIL$         = file name
  3170.         ' MKR          = marker number in help file
  3171.         ' PP$          =
  3172.  
  3173. 13000   IF MKR=81_
  3174.              THEN GOSUB 2640:_                  'print '^K to abort'
  3175.                   FIL$="MENU-HLP":_
  3176.                   GOTO 3250                     'display text file
  3177.  
  3178.         IF MKR=82_
  3179.              THEN GOSUB 2640:_                  'print '^K to abort'
  3180.                   FIL$="EDIT-HLP":_
  3181.                   GOTO 3250                     'display text file
  3182.  
  3183.         OPEN "I", 2, DRIVE$+"MORE-HLP"
  3184.  
  3185. 13030   LINE INPUT #2,B$
  3186.  
  3187.         IF B$<>MID$(STR$(MKR),2)+":"_
  3188.              THEN 13030
  3189.  
  3190. 13050   PRINT MID$(B$,7)
  3191.         LINE INPUT #2,B$
  3192.  
  3193.         IF B$=MID$(STR$(MKR+1),2)+":"_
  3194.              THEN CLOSE 2:_
  3195.                   PRINT:_
  3196.                   PRINT PP$+" ";:_
  3197.                   GOTO 3510                     'process character input
  3198.  
  3199.         IF EOF(2)_
  3200.              THEN CLOSE 2:_
  3201.                   RETURN_
  3202.              ELSE 13050
  3203.  
  3204. '.pa
  3205.         '** Setup for User Comment
  3206.  
  3207.         'Variables:
  3208.         ' I1$          =
  3209.         ' I2$          =
  3210.         ' MSGSUBJ$     = message subject
  3211.         ' MPW$         =
  3212.         ' MX           =
  3213.         ' MZ           =
  3214.         ' MSGTO$       = Message To:
  3215.         ' UID          = addressee user id number
  3216.  
  3217. 15000   GOSUB 30040                             'open index file
  3218.         GET #1,1
  3219.         MZ=CVI(I1$)
  3220.         MX=CVI(I2$)
  3221.         CLOSE 1
  3222.  
  3223.         MSGTO$="SYSOP"
  3224.         MPW$=".READ."
  3225.         MSGSUBJ$="User Comment"
  3226.         UID=1
  3227.  
  3228.         GOTO 751
  3229.  
  3230.         '** Timecheck on, WRTLOC off (After message is written to disk)
  3231.  
  3232.         'Variables:
  3233.         ' MXML         =
  3234.         ' SMX          =
  3235.         ' WRTLOC       =
  3236.  
  3237. 17000   POKE MXML,SMX
  3238.         POKE WRTLOC,0
  3239.         RETURN
  3240.  
  3241.  
  3242.         '** Close  and  delete temp file
  3243.  
  3244.         'Variables:
  3245.         ' RR1$ = input line buffer
  3246. 18000   CLOSE 3
  3247.         KILL "QMSG.$$$"
  3248.         RR1$ = ""
  3249.         RETURN
  3250.  
  3251.  
  3252.         '** Get time and date
  3253.         'line number series 20000
  3254.         %INCLUDE QTIME.INC
  3255.  
  3256. '.pa
  3257.         '** (More?) pause.  Entering ^N/N/n will abort, a space will
  3258.         '   advance one line, anything else will return the response in
  3259.         '   BI for handling by calling routine
  3260.  
  3261. 21000   PRINT " (more?) ";
  3262.         A$ = INPUT$(1)
  3263.  
  3264.         IF A$ <> ""_
  3265.              THEN BI = ASC(A$) AND 31
  3266.  
  3267.         FOR J5 = 1 TO 9:_
  3268.              PRINT ERS$;:_
  3269.         NEXT J5
  3270.  
  3271.         IF BI = 14_                             'user entered 'N'
  3272.              THEN BI = 11                       'abort
  3273.  
  3274.         IF A$ = " "_                            'user entered <space>
  3275.              THEN LL = LL -1_
  3276.              ELSE LL = 1_
  3277.  
  3278.         RETURN
  3279.  
  3280.  
  3281.         '** Word wrap routine
  3282.  
  3283.         'Variables:
  3284.         ' LN           = line length
  3285.         ' K            = line length
  3286.         ' WW$          =
  3287.         ' C$           =
  3288.         ' SAV$         =
  3289.         ' ERS$         = erasable backspace
  3290.  
  3291. 30000   LN=64
  3292.         K=LN
  3293.         WW$=""
  3294. 30004   K=K-1
  3295.         C$=MID$(SAV$,K,1)
  3296.         PRINT ERS$;
  3297.  
  3298.         IF C$=" "_
  3299.              THEN PRINT:_
  3300.                   WW$=RIGHT$(SAV$,LN-K):_
  3301.                   SAV$=LEFT$(SAV$,K):_
  3302.                   RETURN
  3303.  
  3304.         GOTO 30004
  3305.         RETURN
  3306.  
  3307.  
  3308. '.pa
  3309.         '** Open various system files
  3310.  
  3311.         'Variables:
  3312.         ' DRIVE$       = drive assignment
  3313.         ' M1$          = message file number
  3314.         ' RR$          = contents of random record
  3315.         ' I1$          =
  3316.         ' I2$          =
  3317.         ' I3$          =
  3318.  
  3319. 30010   OPEN "R",1,DRIVE$+"COUNTER"+M1$,5
  3320.         FIELD #1,5 AS RR$
  3321.         RETURN
  3322.  
  3323. 30015   OPEN A$,1,DRIVE$+"LCALLER"
  3324.         RETURN
  3325.  
  3326. 30020   OPEN "R",1,DRIVE$+"USERS"+M1$,78
  3327.         RETURN
  3328.  
  3329. 30030   OPEN "R",1,DRIVE$+"MESSAGE"+M1$,65
  3330.         FIELD #1,65 AS RR$
  3331.         RETURN
  3332.  
  3333. 30040   OPEN "R",1,DRIVE$+"MF"+M1$+"-REC",6   '** Index file
  3334.         FIELD #1,2 AS I1$,2 AS I2$,2 AS I3$
  3335.         RETURN
  3336.  
  3337.  
  3338.  
  3339.         '** Check for message flags and erase them for message display
  3340.  
  3341.         'Variables:
  3342.         'RR$           = contents of random record
  3343.         'UID           = user id number
  3344.  
  3345. 30050   UID=VAL(MID$(RR$,56,6))
  3346.         MID$(RR$,56,6)="      "
  3347.         RETURN
  3348. '.pa
  3349.         '** Check for sysop and flag
  3350.  
  3351.         'Variables:
  3352.         ' UF$          = user access level
  3353.         ' SPCL         = special user
  3354.  
  3355. 30060   IF INSTR("$+",UF$)_
  3356.              THEN SPCL=-1_
  3357.              ELSE SPCL=0
  3358.         RETURN
  3359.  
  3360.  
  3361.         '** Read Message Index file.
  3362. 31000   GOSUB 30040
  3363.  
  3364.         IF M>MID _
  3365.              THEN J=MIDRE
  3366.  
  3367.         IF M<MID THEN _
  3368.              J=LOMSGRE
  3369.  
  3370.         FOR I=J TO MZ
  3371.  
  3372.             GET #1,I
  3373.             MSGNDX(1)=CVI(I1$)
  3374.             MSGNDX(2)=CVI(I2$)
  3375.             MSGNDX(3)=CVI(I3$)
  3376.  
  3377.             IF MSGNDX(1)>=M_
  3378.               THEN MRE=MSGNDX(2):_
  3379.               CLOSE 1:_
  3380.               RETURN
  3381.  
  3382.          NEXT
  3383.          MRE=0
  3384.          CLOSE 1
  3385.          RETURN
  3386. '.pa
  3387.