'QRUN.BAS 'Copyright (c) 1989. All rights reserved. 'Main module of QBBS bulletin board system, written by 'Larry Davis, Glendale CA, and updated jointly with Chris McEwen, 'S. Plainfield NJ. 'You are asked to submit updates and improvements to the QBBS 'bulletin board system to Larry Davis on the Glendale Litera, 'at (818) 956-6164, or to Chris McEwen on Socrates Z-Node #32, 'at (201) 754-9067. 'Compile command (where vvvv = version): 'BASCOM =QRUNvvvv/O/E/C/Z 'Link Commmand: 'LD80 QRUNvvvv,QREL/S,OBSLIB/S,QRUNvvvv/N/E 'for LD80 'SLRNK QRUNvvvv/N,/A:100,QRUNvvvv,QREL/S,OBSLIB/S,/E 'for SLRNK 'Search for ">>>>>>>>>>>>>>>>." and replace with 'the name of your RCPM. 'To print a formatted hardcopy of this program, use a global 'search and replace (^QA) to remove the apostrophe before 'the following two 'dot' commands, and all page break commands. '.he QRUN Version 4.10 '.fo Page -#- 'Please refer to QRUNvvvv.HIS for history notes. '.pa '** Establish basic options 'Variables: ' VERS$ = version number OPTION BASE 1 POKE 0,&HCD DEFINT A-Z WIDTH 130 '** Variable definitions: DIM MFILE$(6),_ '6 message files MSGNDX(3) ABORT$="Aborted" BEL$=CHR$(7) 'bell DRIVE$="A:" 'bbs data drive assignment CRLF$=CHR$(13)+CHR$(10) 'carriage return, line feed ERS$=CHR$(8)+" "+CHR$(8) 'eraseable backspace HEADER$=_ " MSG# | DATE | FROM | TO | SUBJECT (LINES)" MSG$="essage" CMSG$="M"+MSG$ MSG$="m"+MSG$ MODE$=" mode" M1$="1" NOSUCH$="Line does not exist" SUBJ$="Subject" VERS$="QRUN v4.10"+CRLF$+"(c) 1989, L. Davis & C. McEwen" CAPS=1 DASHFILE = 0 'for FOR/QNEWS pagination DUP=-1 'duplex on FIRSTPAGE = -1 'for FOR/QNEWS pagination FL = 0 INLINE = -1 PAG=-1 PAGLEN = 23 'page length before (more?) 'Enter -1 if you do allow 'upload mode' of message entry, 'and 0 if you do not UPMODE= -1 '.pa '** Check if BYE is active %INCLUDE QBYCK.INC ' move to user area 0 CMD = 32 DAT = 0 RES = 0 CALL BDOS(CMD,DAT,RES) 'change user areas '** Check for CP/M command line options 'Variables: ' A$ = temporary string ' CC = CPM comment flag ' M1$ = message base number ' MFG = IF PEEK(&H80)=0_ THEN 100 A$=CHR$(PEEK(&H82)) IF A$="C"_ 'CPM comment flag THEN CC=-1:_ GOTO 180 IF A$>"0" AND A$<"7"_ 'direct return to a THEN MFG=-1:_ 'particular message base. M1$=A$ '** Clear screen on login 'Variables: ' NULLS = number of nulls ' I = loop counter 100 POKE 4,0 POKE NULLS,0 PRINT PRINT STRING$(23,10) 'print 23 line feeds POKE NULLS,PEEK(&H3C) '.pa '** Get message file names 'Variables: ' MFILE$(n) = array of message base names ' MFILE$ = name of current message base ' DRIVE$ = drive assignment of bbs data files ' I = loop counter MFILE$(1)="General Topics" MFILE$=MFILE$(1) OPEN "I",1,DRIVE$+"MFILE" FOR I = 2 TO 6 INPUT#1,MFILE$(I) NEXT I CLOSE 1 '** Get D/U 'Variables: ' DRIVE$ = drive assignment of bbs data files ' USER$ = user number of bbs data files ' CPMPASS$ = password to enter CPM mode ' CFIL$ = name of command file ' TZA$ = time zone ' DAT = BDOS command data ' CMD = BDOS command 180 OPEN "I",1,DRIVE$+"PWDS" INPUT #1,DRIVE$,USER$,CPMPASS$,CFIL$,TZA$ CLOSE 1 ' move to data user area CMD = 32 DAT=VAL(USER$) RES = 0 CALL BDOS(CMD,DAT,RES) 'change user areas '.pa '** Open LCALLER and get user parameters 'Variables ' A$ = ' LON$ = last on date ' N$ = user's first name ' O$ = user's last name ' PW$ = user's password ' ST$ = user's state ' UF$ = user's access level ' UP$ = user's parameters ' UR$ = A$="I" GOSUB 30015 'open lcaller file INPUT #1,N$,O$,UF$,UR$,PW$,ST$,UP$,LON$ CLOSE 1 '** Check for sysop, set flag and welcome user 'Variables: ' HOMEBASE$ = User's home message base ' CC = CPM comment ' M1$ = message base number ' MFG = ' N$ = user's first name ' O$ = user's last name ' UN$ = ' UO$ = ' UP$ = user's parameters ' UR = ' UR$ = GOSUB 30060 'check for sysop, set flag UR=VAL(UR$) IF CC_ THEN 280 UN$=N$ UO$=O$ 'Enter the name of your RCPM here: PRINT CRLF$;"Hello, ";N$;".";_ CRLF$;"Welcome to >>>>>>>>>>>>>>>>." 246 ON ERROR_ GOTO 2900 IF MFG_ THEN 10020 '.pa '** Go to message base selection menu 'Variables: ' HOMEBASE$ = User's home message base ' M1$ = message base number ' UP$ = user's parameters HOMEBASE$=MID$(UP$,5,1) IF INSTR("Ww",HOMEBASE$)_ THEN W=-1:_ GOTO 10000 M1$=HOMEBASE$ GOTO 10020 '** Set user defaults 'Variables: ' ATO = auto message read mode ' HOMEBASE$ = User's home message base ' BEL$ = bell ' CC = CPM comment ' CMSG$ = 'Messages' ' CN! = caller number ' LM = ' LON$ = last on date ' M = ' MFILE$ = name of message base ' MSG$ = 'messages' ' NN$ = ' NULLS = number of nulls ' PAG = page pause mode ' HIMSG = high message read ' UP$ = user's parameters ' XPR = expert mode 280 NN$=MID$(UP$,1,1) POKE NULLS,VAL(NN$) IF MID$(UP$,2,1)="X"_ THEN XPR=-1_ ELSE XPR=0 IF MID$(UP$,3,1)="P"_ THEN ATO=-1_ ELSE ATO=0 IF MID$(UP$,4,1)="T"_ THEN PAG=-1_ ELSE PAG=0 HOMEBASE$=MID$(UP$,5,1) IF CC_ THEN 15000 PRINT CRLF$;"Current ";CMSG$;" File: "+MFILE$ PRINT CRLF$;"You are caller #";CN! PRINT "Last on line ";LON$ PRINT "There are";M;"active messages" PRINT "High ";MSG$;" this call is";HIMSG IF LON$="--"_ THEN 380 IF LM<=HIMSG_ THEN PRINT "High ";MSG$;" your last call was";LM:_ GOTO 380 PRINT CMSG$;"s have been renumbered.";BEL$ '.pa '** Read index, check for mail, load array 'Variables: ' ATO = auto message read mode ' CRLF$ = carriage return, line feed ' I1$ = ' I2$ = ' I3$ = ' IM = ' LOMSG = low message read ' LM = ' LON$ = last on date ' MSGNDX(n,n) = message array index ' ML = ' MX = ' MZ = ' OLD = ' SPCL = special user ' HIMSG = high message read ' UR = ' Z = number of new messages to user 380 LON$="" ML=0 LMFOUND=0 Z=0 OLD=0 LO=0 MID=0 MD=0 GOSUB 30040 'open index file GET #1,1 MZ=CVI(I1$) MX=CVI(I2$) MID=MZ\2 IF MZ=0_ THEN MZ=1:_ CLOSE 1:_ GOTO 515 FOR I=2 TO MZ GET #1,I MSGNDX(1)=CVI(I1$) MSGNDX(2)=CVI(I2$) MSGNDX(3)=CVI(I3$) IF MSGNDX(1)<>0 AND (NOT LO)_ THEN LOMSG=MSGNDX(1):_ LOMSGRE=I:_ LO=-1 IF MSGNDX(1)<>0 AND (I>=MID) AND (NOT MD)_ THEN MID=MSGNDX(1):_ MIDRE=I:MD=-1 IF MSGNDX(3)=UR_ THEN ML=-1:_ IF MSGNDX(1)> LM_ THEN Z=Z+1_ ELSE OLD=-1 IF SPCL AND MSGNDX(3)=1_ THEN ML=-1:_ IF MSGNDX(1)> LM_ THEN Z=Z+1_ ELSE OLD=-1 NEXT CLOSE 1 IF Z=0_ THEN ML=0:_ GOTO 515 PRINT CRLF$;"You have mail waiting." PRINT CRLF$;"Enter 'M' to read";Z;"new ";msg$;BEL$ IF Z=1_ THEN PRINT "."_ ELSE PRINT "s." 515 IF ML=0_ THEN PRINT CRLF$;"You have no mail today." IF HIMSG=LM_ THEN 520 IF ATO_ THEN PRINT CRLF$;"(Auto-Read enabled)":_ GOSUB 6000 'read new messages '.pa '** Main menu command entry 'Variables: ' A1$ = ' B$ = ' BEL$ = bell ' DATE$ = date ' FF = temporary integer, command pointer ' CRLF$ = carriage return, line feed ' MKR = marker number in help file ' RTC = memory address of RTC in BYE ' SMX = ' TZA = ' XPR = expert user 520 IF XPR_ THEN 530_ GOSUB 20000 'get and format date DATE$=DATE$+" "+TZA$ PRINT CRLF$ PRINT DATE$; PRINT " [Minutes "; IF SMX=0 OR PEEK(WHEEL)=255_ THEN PRINT "on: ";PEEK(RTC+7);"]";:_ ELSE PRINT "remaining: ";SMX-PEEK(RTC+7);"]"; 530 KEY=0 A1$="COMMAND:" IF XPR=0 THEN_ A1$=CRLF$ +_ "(A,B,C,D,E,F,G,H,I,K,L,M,N,P,R,S,U,V,X,<,>) ? for HELP"_ +CRLF$+A1$ GOSUB 2660 'print a$ or a1$ MKR=81 CAPS=1 GOSUB 2750 'get command to b$ IF B$=""_ THEN 530 FF=INSTR("YERSKGCJIAXDUBNFPMZLHVWQ>.<,",B$) GOSUB 570 GOTO 520 '.pa 570 ON FF_ GOTO 00630,_ 'Y Display Special User file 00750,_ 'E Enter a message 01620,_ 'R Read messages 01880,_ 'S Scan messages 02290,_ 'K Kill a message 02170,_ 'G Goodbye 00650,_ 'C drop to CPM 00650,_ 'J drop to CPM 02560,_ 'I Inspect User files 03190,_ 'A Auto-Read mode toggle 03170,_ 'X Expert User toggle 03150,_ 'D Set nulls 02950,_ 'U Set user parameters 00620,_ 'B Display bulletin 06000,_ 'N Read New messages 10000,_ 'F Set file number 03204,_ 'P Set Page Pause 01600,_ 'M Read personal mail 12000,_ 'Z Print Callers file 00615,_ 'L Display long help file 03208,_ 'H Set home base 08100,_ 'V Show version of QRUN 00635,_ 'W What's the new files? 00640,_ 'Q QBBS Announcements 09000,_ '> Move up one msg area 09000,_ '. Move up one msg area 09010,_ '< Move down one msg area 09010 ', Move down one msg area IF LEFT$(B$,1)="/"_ THEN RETURN IF VAL(B$)>0 AND VAL(B$)<7_ 'TR Mod THEN 8900 IF B$="BYE" _ THEN END 580 PRINT BEL$; MKR=81 GOTO 13000 'display main menu RETURN '.pa '** Display various text files 'Variables: ' FIL$ = file name to print ' M1$ = message base number ' SPCL = special user ' UF$ = user's access level 'display long help file 615 GOSUB 2640 'print '^K to abort' FIL$="MORE-HLP" '--> convert MORE-HLP to pagination by inserting '----' in left 4 ' columns where you want the page breaks to happen. DASHFILE = -1 'CLM: for pagination FL = 0 GOTO 3250 'display text file 'display bulletin 620 GOSUB 2640 'print '^K to abort' FL = 0 621 IF M1$="6"_ THEN FIL$="S-INFO":_ GOTO 3250 'display text file 622 FIL$="BULLET"+M1$ GOTO 3250 'display text file 'display special user bulletin 630 IF INSTR("+$S",UF$)_ THEN FIL$="S-INTRO":_ FL = 0:_ GOTO 3250_ 'display text file ELSE 580 'display FOR file 'TR MOD 635 GOSUB 2640 FIL$="FOR" FL = 0 GOTO 3250 'display QNEWS file 640 GOSUB 2640 'TR MOD FIL$="QNEWS" DASHFILE = -1 'CLM: for pagination GOTO 3250 'END ADDITIONAL CODE '.pa '** CP/M access and password check 'Variables: ' A1$ = ' B$ = ' CFIL$ = name of chain file ' CMD = BDOS command ' CPMPASS$ = CPM password ' DAT = BDOS command data ' MXML = ' RES = BDOS result ' SPCL = special user ' UF$ = user's access level ' XPR = expert mode 650 IF INSTR("*C",UF$)_ THEN 8000 675 IF SPCL_ THEN POKE MXML,0:_ GOTO 720 IF CPMPASS$="NOPASS"_ THEN 720 A1$="Password?" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ IF B$<>CPMPASS$_ THEN PRINT "Invalid password.":_ RETURN 720 CMD = 32 DAT=0 RES = 0 CALL BDOS(CMD,DAT,RES) 'change user areas '** Run COMfile and exit 735 POKE 0,&HC3 CMD = 65 CALL BDOS(CMD,DAT,RES) 'carrier test IF RES=0_ 'we are not on line THEN POKE &H52,&H6A IF CC = -1_ THEN END_ 'return from Comment ELSE RUN "A:"+CFIL$ 'leaving QBBS '.pa '** Enter a message (GB=Goodbye command, CC=CP/M comment) 'Variables: ' A$ = ' A1$ = ' ABORT$ = "Aborted" ' ANSR = ' B$ = ' BEL$ = bell ' CAPS = capitalization flag ' CC = CPM comment flag ' CHC = ' CNTU = ' CMSG$ = 'Message' ' CPM$ = ' CRLF$ = carriage return, line feed ' DUP = ' DEST$ = ' F = ' FF = temporary integer ' GB = goodbye comment ' MSGSUBJ$ = message subject ' KEY = full/half duplex flag ' KIL = ' L = ' M = ' MKR = marker number in help file ' MPW$ = ' MSG = ' MSG$ = ' MXML = ' MZ = ' N = ' PR = ' R1 = ' RR$ = contents of random record ' SAV$ = ' SAVID = ' SAVM = ' SAVP = ' SMSG = sysop message ' SUBJ$ = 'Subject' ' T = ' MSGTO$ = ' HIMSG = high message read ' UF$ = user's access level ' UID = ' WW$ = ' XPR = expert mode '.pa 750 IF INSTR("*MN",UF$)_ THEN 8000 751 POKE MXML,0 SMSG=0 T=0 KEY=-1 IF GB_ THEN 760 IF ANSR AND SAVP_ THEN PRINT CRLF$;"Kill the above ";MSG$;"? ";:_ GOSUB 2750:_ 'get command to b$ MKR=0:_ B$=LEFT$(B$,1):_ IF B$="Y"_ THEN M=SAVM:_ CLOSE 1:_ KIL=-1:_ GOSUB 2310 'kill message IF GB OR CC_ THEN 760 IF UF$="$"_ THEN A1$=CRLF$+"SYSOP "+MSG$+"?":_ GOSUB 2660:_ 'print a$ or a1$ GOSUB 2750:_ 'get command to b$ IF B$="Y"_ THEN SMSG=-1 760 GOSUB 30010 'open counter file GET#1,3 V=VAL(RR$) F=0 CLOSE 1 IF GB OR CC_ THEN 800 IF ANSR_ THEN UID=SAVID:_ GOTO 795 A1$=CRLF$+"Who to? ( for ALL):" GOSUB 2660 'print a$ or a1$ MKR=1 GOSUB 2750 'get command to b$ IF B$=""_ THEN MSGTO$="ALL"_ ELSE MSGTO$=B$ IF LEFT$(MSGTO$,3)="SYS"_ THEN UID=1:_ GOTO 800 IF MSGTO$="ALL"_ THEN UID=0:_ GOTO 800_ ELSE MSG=2:_ GOSUB 2570:_ 'find user MSG=0:_ CPM$=LEFT$(DEST$,LEN(MSGTO$)):_ IF CPM$<>MSGTO$_ THEN PRINT CRLF$;MSGTO$;_ " is not a current user";_ " or name is misspelled.":_ RETURN 795 IF ANSR_ THEN PRINT CRLF$;"To: ";TAB(10);MSGTO$:_ GOTO 817 800 IF GB OR CC_ THEN 905 A1$=SUBJ$+":" GOSUB 2660 'print a$ or a1$ CAPS=0 GOSUB 2750 'get command to b$ MSGSUBJ$=B$ IF MSGSUBJ$=""_ THEN PRINT ABORT$:_ GB=0:_ GOSUB 17000:_ 'timecheck on, wrtloc off IF CC_ THEN 735_ ELSE RETURN GOTO 820 817 IF GB OR CC_ THEN 1010 SAV$=MSGSUBJ$ CHC=LEN(MSGSUBJ$) PRINT SUBJ$;": ";MSGSUBJ$; GOSUB 3510 'process character input B$=SAV$ SAV$="" IF B$<>""_ THEN MSGSUBJ$=B$ 820 IF LEN(MSGSUBJ$)>26_ THEN PRINT CRLF$;SUBJ$;" is too long.";_ CRLF$;"Maximum is 25 characters.";_ CRLF$;BEL$:_ IF (ANSR OR T)_ THEN 817_ ELSE 800 MPW$=PW$ IF MSGTO$="ALL"_ THEN IF T_ THEN 1010_ ELSE 850 A1$="Private? (y,N):" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ B$=LEFT$(B$,1) IF B$="Y"_ THEN MPW$=".READ." IF T_ THEN 1010 850 IF UPMODE=0_ 'TR MOD THEN B$="K":_ GOTO 855 A1$="(K)eyboard entry or (U)pload"+MODE$+"?" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ B$=LEFT$(B$,1) 'TR MOD 855 IF B$="U"_ THEN KEY=0_ ELSE KEY=-1 '.pa ' Open temporary editor file 905 OPEN "R", 3, "QMSG.$$$", 65 FIELD #3, 65 AS RR1$ IF T_ THEN 1010 PRINT "Enter ";MSG$; IF KEY_ THEN PRINT " (Keyboard entry)"_ ELSE PRINT " (Upload"+MODE$+")" IF KEY_ THEN PRINT "Hit RETURN twice";_ ELSE PRINT "Enter '/' on a blank line"; PRINT " for EDIT menu" WR$="" 930 PRINT ":";STRING$(61,45);":" IF KEY=0_ THEN DUP=0 BLK = 0 'Count the blank lines 950 F=F+1 IF WW$<>""_ THEN PRINT WW$;:_ CHC=LEN(WW$):_ WW$="":_ GOSUB 3510:_ 'process character input GOTO 980 N=1 MKR=0 GOSUB 3500 'process input character IF SAV$=""_ THEN IF KEY_ THEN F=F-1:_ GOTO 1010_ ELSE BLK = BLK + 1_ ELSE BLK = 0 IF BLK = 10_ THEN PRINT "Enter '/' on a blank line for EDIT menu" + BEL$:_ BLK = 0 '.pa IF KEY=0 AND SAV$="/"_ THEN F=F-1:_ GOTO 1010 980 B$=SAV$ SAV$=WW$ LSET RR1$ = B$ + " " PUT#3, F GOTO 950 1010 PRINT: A1$ = "(" + MID$(STR$(F),2) + " lines entered)" + CRLF$ IF XPR_ THEN A1$ = A1$ + "(A,C,D,E,I,L,P,S,T,?):"_ ELSE A1$ = A1$ +_ "(A)bort (C)ontinue (D)elete (E)dit (L)ist " + CRLF$ +_ "(I)nsert (P)review (S)ave (T)itle (? for HELP):" GOSUB 2660 'print a$ or a1$ DUP=-1 KEY = -1 PR=0 MKR=82 GOSUB 2750 'get command to b$ IF R1_ THEN CNTU=0 IF B$=""_ THEN IF NCH=63_ THEN 1010_ ELSE B$="L" FF = INSTR("PLADICEST",LEFT$(B$,1)) ON FF_ GOTO 1020,_ 'P list msg w/o line # 1022,_ 'L list msg w/line # 1024,_ 'A answer msg 1300,_ 'D delete a line 1340,_ 'I insert a line 0950,_ 'C continue 1150,_ 'E edit a line 1390,_ 'S save message 1030 'T change msg title ' will default to listing ' msg w/o line numbers. IF SAV$ = "?"_ 'User had asked for help THEN GOTO 1010 1020 PR=-1 'list msg w/o line # 1022 GOSUB 2640 'list msg w / line # PRINT LL = 1 FOR L = 1 TO F IF PR = 0_ THEN PRINT RIGHT$(" " + STR$(L) + "> ", 5); GET #3, L RR$ = RR1$ GOSUB 3110 A$ = S$ GOSUB 2660 LL = LL + 1 IF LL MOD PAGLEN = 0_ THEN GOSUB 21000 '(more?) IF BI = 11 OR BI = 24_ 'abort with ^K/K/k/^X/X/x THEN L = F NEXT L A$ = "" PRINT GOTO 1010 1024 A1$="Abort?" GOSUB 2660 GOSUB 2750 B$=LEFT$(B$,1) IF B$<>"Y" THEN 1010 PRINT ABORT$ 'abort msg GOSUB 17000 'timecheck on, wrtloc off GOSUB 18000 'close and delete temp file IF GB_ THEN 2280_ ELSE IF CC_ THEN 735_ ELSE RETURN 1030 T=-1 'change title of msg PRINT GOTO 817 '** Line editing routines 'Variables: ' A1$ = ' ABORT$ = "Aborted" ' ANS = ' B$ = ' BEL$ = bell ' CRLF$ = carriage return, line feed ' F = highest element in array ' L = ' LENGTH = length of line ' NAM$ = ' NUM = ' R = 1150 PRINT A1$="Edit which line?" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ L=VAL(B$) 1160 IF L=0 OR L>F_ THEN 1010_ ELSE GET #3, L:_ PRINT CRLF$;"Original Line:";_ CRLF$;LEFT$(RR1$,63) LENGTH=63 IF R=1_ THEN 1167_ ELSE GET #3, L:_ NAM$=LEFT$(RR1$,63) NAM$=NAM$+STRING$(LENGTH-LEN(NAM$),160) 1167 PRINT CRLF$;_ "Edit Line: (Ctrl-V for HELP, Ctrl-Q to ABORT, Return to END):" PRINT NAM$+CHR$(13); R=0 FOR NUM = 1 TO LENGTH '** Get/process single character 1171 ANS=ASC(INPUT$(1)) IF ANS=13_ THEN 1260 IF ANS=30 OR ANS=5_ THEN ANS=94 IF ANS=8 OR ANS=19_ THEN ANS=60 IF ANS=12 OR ANS=4_ THEN ANS=62 '** Filter out unwanted control characters IF ANS<17 OR ANS=18 OR ANS=20 OR ANS=21_ THEN 1171 IF ANS=23 OR (ANS>24 AND ANS<32)_ THEN 1171 PRINT CHR$(ANS); IF ANS=62 AND NUM=LENGTH_ THEN PRINT CHR$(8);MID$(NAM$,NUM,1);_ CHR$(8);BEL$;:_ NUM=NUM-1:_ GOTO 1250 IF ANS=62_ THEN PRINT CHR$(8);MID$(NAM$,NUM,1);:_ GOTO 1250 IF ANS=60 AND NUM>1_ THEN PRINT CHR$(8);MID$(NAM$,NUM,1);_ CHR$(8);CHR$(8);:_ NUM=NUM-2:_ GOTO 1250 IF ANS=60 AND NUM=1_ THEN PRINT CHR$(8);MID$(NAM$,NUM,1);CHR$(8);:_ NUM=NUM-1:_ GOTO 1250 IF ANS=94_ THEN NAM$=LEFT$(NAM$,NUM-1)+" "+_ MID$(NAM$,NUM,LENGTH-NUM):_ PRINT CHR$(8);RIGHT$(NAM$,LENGTH-NUM+1);_ STRING$(LENGTH-NUM+1,8);:_ NUM=NUM-1:_ GOTO 1250 '.pa IF ANS=24_ THEN NAM$=LEFT$(NAM$,NUM-1)+RIGHT$(NAM$,LENGTH-NUM)+_ CHR$(160):_ PRINT RIGHT$(NAM$,LENGTH-NUM+1);_ STRING$(LENGTH-NUM+1,8);:_ NUM=NUM-1:_ GOTO 1250 IF ANS=22_ THEN PRINT CRLF$;CRLF$;_ "'<' = Move Left, '>' = Move Right, ";_ "'^' = Ins CHR, 'Ctrl-X' = Del CHR":_ R=1:_ GOTO 1160 IF ANS=17_ THEN PRINT CRLF$;"EDIT ";ABORT$:_ GOTO 1010 NAM$=LEFT$(NAM$,NUM-1) +CHR$(ANS)+RIGHT$(NAM$,LENGTH-NUM) IF NUM=LENGTH_ THEN PRINT CHR$(8);:_ NUM=NUM-1 1250 NEXT NUM 1260 FOR NUM=1 TO LENGTH IF MID$(NAM$,NUM,1)=CHR$(160)_ THEN NAM$=LEFT$(NAM$,NUM-1)+" "+_ RIGHT$(NAM$,LENGTH-NUM) NEXT NUM LSET RR1$ = NAM$ PUT#3, L PRINT GOTO 1010 '.pa '** DELETE a line 'Variables: ' A$ = ' A1$ = ' B$ = ' D = ' F = highest line in message array ' MKR = marker number in help file ' NOSUCH$ = "Line does not exist" ' X = 1300 A1$="Line # to DELETE:" GOSUB 2660 'print a$ or a1$ MKR=0 GOSUB 2750 'get command to b$ D=VAL(B$) IF D=0 OR D>F_ THEN PRINT NOSUCH$:_ GOTO 1010 PRINT "Line #"+STR$(D)+":" GET #3, D PRINT RR1$ A$="Delete this line?" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ IF B$<>"Y"_ THEN PRINT "Not deleted":_ GOTO 1010 FOR X= D TO F GET #3, X+1 PUT #3, X NEXT F=F-1 PRINT "Line deleted" GOTO 1010 '.pa '** INSERT a line 'Variables: ' A1$ = ' B$ = ' F = highest line number in array ' INS = insert mode flag ' LN = ' MKR = marker number in help file ' N = ' NOSUCH$ = "Line does not exist" ' SAV$ = ' X = 1340 A1$="INSERT before line #:" GOSUB 2660 'print a$ or a1$ MKR=0 GOSUB 2750 'get command to b$ LN=VAL(B$) IF LN=0 OR LN>F_ THEN PRINT NOSUCH$:_ GOTO 1385 A$=STR$(LN)+">" IF LN<10_ THEN A$=" "+A$ N=1 INS=-1 GOSUB 2660 'print a$ or a1$ GOSUB 3500 'process input character IF SAV$=""_ THEN 1385 FOR X= F TO LN STEP -1 GET #3, X PUT #3, X+1 NEXT X F=F+1 LSET RR1$ = SAV$ PUT #3,LN 1385 SAV$="" INS=0 GOTO 1010 '.pa '** Save message 'Variables: ' ANSR = ' CC = CP/M comment flag ' CRLF$ = carriage return, line feed ' DATE$ = date ' F = ' FLS = ' GB = goodbye flag ' I1$ = ' I2$ = ' I3$ = ' MSGSUBJ$ = message subject ' MSGNDX(n,n) = message array index ' MFILE$ = name of message base ' MPW$ = ' MSG$ = "message" ' MX = ' MZ = ' N$ = user's first name ' O$ = user's last name ' P = loop counter ' R1 = ' RE = random record number ' RL = length of random record ' RR$ = contents of random record ' S$ = temporary string before placing in random buffer ' SAVRE = saved record number in message file ' SMGS = sysop message flag ' SPW$ = message password ' MSGTO$ = message to: ' HIMSG = high message read ' UF$ = user access level ' UID ' UR ' V ' WRTLOC = write lock 1390 SPW$=";"+MPW$ IF GB OR CC_ THEN 1410 PRINT CRLF$;"Saving ";MSG$;" #";STR$(V+1);_ " in ";MFILE$;" ";MSG$;" file.";CRLF$ IF UF$="$" AND F=0_ THEN FLS=-1 1410 GOSUB 20000 'get and format date POKE WRTLOC,255 1510 GOSUB 30010 'open counter file 1520 GET#1,3 LSET RR$=STR$(VAL(RR$)+1) PUT#1,3 1521 GET#1,1 LSET RR$=STR$(VAL(RR$)+1) PUT#1,1 1522 CLOSE 1 GOSUB 30030 'open message file RL=65 '** MESSAGE RE=MX+1 SAVRE=RE S$=STR$(V+1)+SPW$ GOSUB 3100 'place s$ in random buffer 1523 PUT#1,RE S$=DATE$ GOSUB 3100 'place s$ in random buffer 1524 IF FLS_ THEN MID$(RR$,57)="1":_ FLS=0 1525 PUT#1,RE+1 1526 IF SMSG_ THEN S$="SYSOP"_ ELSE S$=N$+" "+O$ 1527 GOSUB 3100 'place s$ in random buffer MID$(RR$,56)=STR$(UR) PUT#1,RE+2 1528 S$=MSGTO$ GOSUB 3100 'place s$ in random buffer MID$(RR$,56)=STR$(UID) PUT#1,RE+3 1529 S$=MSGSUBJ$ GOSUB 3100 'place s$ in random buffer PUT#1,RE+4 1530 S$=STR$(F) GOSUB 3100 'place s$ in random buffer PUT#1,RE+5 1531 RE=RE+6 1532 FOR P=1 TO F GET#3, P S$ = RR1$ GOSUB 3100 'place s$ in random buffer PUT#1,RE RE=RE+1 IF P MOD 10 = 0_ THEN PRINT STR$(P) + " lines saved." + CHR$(13); NEXT P 1533 S$="32000" GOSUB 3100 'place s$ in random buffer PUT#1,RE 1534 CLOSE 1 MX=MX+F+6 MZ=MZ+1 HIMSG=HIMSG+1 GOSUB 30040 'open index file 1535 LSET I1$=MKI$(MZ) LSET I2$=MKI$(MX) PUT #1,1 '** INDEX 1536 LSET I1$=MKI$(V+1) LSET I2$=MKI$(SAVRE) LSET I3$=MKI$(UID) PUT #1,MZ 1537 CLOSE 1 PRINT STR$(P-1) + " lines saved." POKE WRTLOC,0 GOSUB 18000 'close and delete temp file GOSUB 17000 'timecheck on, wrtloc off 1538 IF GB OR CC THEN_ PRINT CRLF$;"Thanks for the comment, ";N$ IF CC_ THEN 735_ ELSE IF GB_ THEN END IF R1_ THEN CNTU=0 ANSR=0 RETURN '.pa '** Read personal mail 'Variables: ' A1$ = ' CRLF$ = carriage return, line feed ' B$ = ' ML1 = ' NEWR = ' OLDR = ' OLD = ' SAVI = 1600 ML1=-1 CLOSE 1 A1$=CRLF$+"Re-read old mail?" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ IF LEFT$(B$,1)="Y"_ THEN OLDR=-1:SAVI=1:_ ELSE NEWR=-1:SAVI=1 'SAVI=LMI 1602 P1=1 SKP=-1 CNTU=0 LMSG=0 R1=0 CLOSE 1 GOSUB 30040 'OPEN MESSAGE INDEX MGOT=0 FOR I=SAVI+1 TO MZ GET #1,I MSGNDX(1)=CVI(I1$) MSGNDX(2)=CVI(I2$) MSGNDX(3)=CVI(I3$) M3=MSGNDX(3) IF MSGNDX(1)=0_ THEN 1603 IF OLDR AND M3=UR AND MSGNDX(1)LM_ THEN SAVI=I:MGOT=-1 IF MGOT_ THEN MRE=MSGNDX(2):_ CLOSE 1:_ GOTO 1685 MGOT=0 IF NOT SPCL THEN 1603 IF OLDR AND M3=1 AND MSGNDX(1)LM_ THEN SAVI=I:MGOT=-1 IF MGOT_ THEN MRE=MSGNDX(2):_ CLOSE 1:_ GOTO 1685 1603 NEXT I GOTO 1870 1618 IF D1=0_ THEN 1620 'read messages PRINT CRLF$;"No new messages found." D1=0 RETURN '.pa '** Prompt to read individual messages 'Variables: ' A1$ = ' B$ = ' CNTU = ' CRLF$ = carriage return, line feed ' G = ' LOMSG = low message read ' LMSG = ' M = ' MI = ' MKR = marker number in help file ' ML1 = ' MSG$ = "message" ' MZ = ' P1 = ' PAG = page pause mode ' OK = ' R1 = ' RE = randcom record number ' SKP = skip flag ' HIMSG = high message read ' XPR = expert mode 1620 PRINT A1$=CMSG$+" # ("+MID$(STR$(LOMSG),2)+"-"+MID$(STR$(HIMSG),2)+")" IF XPR=0_ THEN A1$=A1$+" to read? (C/R to end)" A1$=A1$+":" GOSUB 2660 'print a$ or a1$ DISP=0 MKR=2 PAST=0 DEL=0 GOSUB 2750 'get command to b$ 1640 IF LEN(B$)=0_ THEN M=0_ ELSE M=VAL(B$) '.pa 1650 IF M<1_ THEN PRINT:_ GOTO 1870 IF M>HIMSG_ THEN 1618_ ELSE IF ML1=0_ THEN GOSUB 2640 'print '^K to abort' P1=1 SKP=-1 CNTU=0 LMSG=0 R1=0 IF (NOT XPR)_ THEN PRINT "Enter ^X,X,x to skip this ";MSG$; IF RIGHT$(B$,1)="+"_ THEN CNTU=-1_ ELSE R1=-1 1680 GOSUB 31000 'find message in index IF MRE=0 THEN PRINT BEL$;:RETURN 1685 GOSUB 30030 'open message file 1690 GOSUB 3440 'test for private message IF PAST THEN 1870 IF OK=0 OR M=0_ THEN 1690 1721 IF SKP_ THEN CNTU=-1:_ GOTO 1755 IF PAG AND P1=0_ THEN 1723_ ELSE 1755 '.pa '** Process message options 'Variables: ' ANSR = ' B$ = ' CMD = BDOS command ' CNTU = ' D1 = ' KKIL = ' LMSG = ' LST = line printer flag ' M = ' ML1 = ' NO$ = ' R1 = ' RES = BDOS result ' SAVM = ' SAVP = ' SKP = skip flag ' SPCL = special user ' MSGTO$ = message to: ' UF$ = user's access level ' XPR = expert mode 1723 IF XPR_ THEN PRINT "R,A,N,Q";_ ELSE PRINT "(R)ead again, (A)nswer, ";_ "(N)ext, (Q)uit"; IF SAVP OR SPCL_ THEN IF XPR_ THEN PRINT ",K";_ ELSE PRINT ", (K)ill"; IF UF$="$"_ THEN IF XPR_ THEN PRINT ",P";_ ELSE PRINT ", (P)rint"; PRINT ": "; '.pa 1726 B$=INPUT$(1) CALL UCASE(B$) LST=0 FF=INSTR("RANQKP "+CHR$(13),B$) ON FF_ GOTO 1730,_ 'R read msg again 1734,_ 'A answer msg 1740,_ 'N read next msg 1738,_ 'Q quit msg read 1736,_ 'K kill msg 1732,_ 'P print hard copy 1740,_ ' read next msg 1740 ' read next msg GOTO 1726 1730 M=SAVM 'read msg again PRINT B$ CLOSE 1 SKP=-1 GOTO 1680 1732 IF UF$<>"$"_ 'print hard copy THEN 1726 CMD = 65 CALL BDOS(CMD,DAT,RES) 'carrier test IF RES=255_ THEN 1726_ ELSE M=SAVM:_ CLOSE 1:_ SKP=-1:_ LST=-1:_ GOTO 1680 1734 MSGTO$=NO$:_ 'answer msg ANSR=-1:_ PRINT B$:_ CLOSE 1:_ GOSUB 750:_ 'enter a message ANSR=0:_ IF ML1_ THEN 1602_ ELSE IF CNTU_ THEN B$=STR$(SAVM)+"+":_ D1=0:_ GOTO 1650_ ELSE CLOSE 1:_ GOTO 1620 'read messages '.pa 1736 IF SAVP=0 AND SPCL=0_ THEN 1726 CLOSE 1 'kill message PRINT B$ KKIL=-1 M=SAVM GOSUB 2310 'kill message IF ML1 THEN 1602_ ELSE M=SAVM+1:_ SKP=-1:_ GOTO 1650 1738 PRINT B$ 'quit msg read PRINT GOTO 1870 1740 PRINT B$ 'read next msg 1747 CNTU=-1 IF LMSG_ THEN 1870_ ELSE IF ML1_ THEN 1602 IF R1_ THEN CLOSE 1:_ GOTO 1620 'read messages PRINT '.pa '** Get/Display message 'Variables: ' A$ = ' BI = ' CRLF$ = carriage return, line feed ' CNTU = ' D1 = ' DATE$ = date ' FL = ' G = ' J = ' MSGSUBJ$ = message subject ' LMSG = ' LST = line printer flag ' M = ' MFILE$ = name of message base ' MI = ' ML1 = ' NEWR = ' NO$ = ' OLDR = ' P = loop counter ' P1 = ' PAG = page pause mode ' PERS = ' PR$ = "Personal" or "Public" ' RCV = message received flag ' SAVID = ' RCV$ = message received ' RE = random record number ' RR$ = contents of random record ' S$ = ' SAVM = ' SAVP = ' SAVRC = ' SAVUID = ' SKP = skip message flag ' SPCL = special user ' MSGTO$ = message to: ' HIMSG = high message read ' UID = ' UR = 1755 SAVM=M SAVP=PERS RCV=0 GET#1,RE+1 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces DATE$=S$ IF UID=1_ THEN FL=-1 GET#1,RE+2 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces NO$=S$ SAVID=UID GET#1,RE+3 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces MSGTO$=S$ SAVUID=UID GET#1,RE+4 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces MSGSUBJ$=S$ SAVRC=RE+4 GET#1,RE+5 J=VAL(RR$) P1=0 SKP=0 RE=RE+6 IF UID=1_ THEN RCV$=" "_ ELSE RCV$="" IF PERS_ THEN PR$="Private"_ ELSE PR$="Public" IF LST_ THEN LPRINT CRLF$;"#";M;NO$;" --> "MSGTO$;_ RCV$;" --> ";MSGSUBJ$;_ " <";MFILE$;">";"<";PR$;">";_ CRLF$;DATE$;CRLF$ PRINT CRLF$;STRING$(50,61) PRINT " MSG#: " ;STR$(M);TAB(18); "| FROM: ";NO$ PRINT " DATE: ";LEFT$(DATE$,8);TAB(18);"| TO: ";MSGTO$;RCV$ PRINT " TIME: ";MID$(DATE$,10);TAB(18);"| SUBJ: ";MSGSUBJ$ PRINT " TYPE: ";PR$;TAB(18); "| FILE: ";MFILE$ PRINT STRING$(50,45) LL = 6 'for (more?) pause '.pa '** Display text file if flag set IF FL_ THEN FIL$=MID$(STR$(M),2)+".MF"+M1$:_ GOSUB 3250:_ 'display text file FL=0:_ IF BI = 11_ THEN 1850_ 'user aborted ELSE 1820 '** Display message from message file FOR P=1 TO J GET#1,RE GOSUB 3110 'clear trailing spaces A$=S$ GOSUB 2660 'print a$ or a1$ LL = LL + 1 IF LL MOD PAGLEN = 0 AND PAG <> 0_ 'page pause THEN GOSUB 21000 '(more?) IF BI=11_ '^K/K/k abort read THEN 1850 IF BI=24_ '^X/X/x skip message THEN PRINT CRLF$;"[Skipping message]":_ IF ML1_ THEN 1602_ ELSE BI=0:_ SKP=-1:_ GOTO 1850 RE = RE + 1 NEXT P 1820 PRINT IF UR=SAVUID_ THEN RCV=-1 IF SAVUID=1 AND SPCL_ THEN RCV=-1 IF UID=1_ THEN RCV=0 '.pa IF RCV_ THEN S$=MSGSUBJ$:_ GOSUB 3100:_ 'place s$ in random buffer MID$(RR$,57)="1":_ PUT #1,SAVRC IF ML1 AND PAG=0_ THEN 1602 1850 IF CNTU=0_ THEN CLOSE 1:_ GOTO 1620 'read messages M=M+1 IF M<=HIMSG_ THEN 1690 IF CNTU AND PAG_ THEN LMSG=-1:_ GOTO 1723 1870 CLOSE 1 D1=0 LST=0 ML1=0 NEWR=0 NO$="" OLDR=0 MGOT=0 PAST=0 RETURN '.pa '** Prompt to scan messages 'Variables: ' A$ = temporary string ' A1$ = ' B$ = ' CRLF$ = carriage return, line feed ' DATE$ = date ' HEADER = ' G = ' LOMSG = low message read ' MSGSUBJ$ = message subject ' L = line count ' LE$ = ' MSGNDX(n,n) = message array index ' MKR = marker number in help file ' MI = ' M = ' MZ = ' NO$ = ' OK = ' PAG = page pause mode ' PERS$ = ' RE = random record number ' S$ = ' SAV$ = ' MSGTO$ = ' HIMSG = high message read ' XPR = expert mode 1880 MKR=6 HEADER=-1 A1$=CRLF$+"Msg # ("+MID$(STR$(LOMSG),2)+"-"+MID$(STR$(HIMSG),2)+")" IF XPR=0_ THEN A1$=A1$+" to start? (C/R to end)" A1$=A1$+":" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ IF LEN(B$)=0_ THEN M=0_ ELSE M=VAL(B$):_ GOSUB 2740 'clear a$, n '.pa 1950 IF M<1_ THEN RETURN IF M>HIMSG_ THEN SAV$="":_ RETURN GOSUB 2640 'print '^K to abort' PRINT 1980 GOSUB 31000 'get record number from index GOSUB 30030 'open message file 1990 GOSUB 3440 'test for private message IF M>HIMSG_ THEN 2160 IF PAST THEN 2160 IF OK=0 OR M=0_ THEN 1990 GET#1,RE+1 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces DATE$=S$ GET#1,RE+2 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces NO$=S$ GET#1,RE+3 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces MSGTO$=S$ GET#1,RE+4 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces MSGSUBJ$=S$ GET#1,RE+5 GOSUB 3110 'clear trailing spaces LE$=S$ IF VAL(LE$)=0_ THEN LE$=" F" IF LEFT$(NO$,3)<>"SYS"_ THEN NO$=MID$(NO$,INSTR(NO$," ")+1) '.pa IF MSGTO$<>"ALL" AND LEFT$(MSGTO$,3)<>"SYS"_ THEN MSGTO$=MID$(MSGTO$,INSTR(MSGTO$," ")+1) IF HEADER_ THEN HEADER=0:_ GOTO 2109 IF LL MOD PAGLEN <> 0 OR PAG = 0_ 'skip page pause THEN 2110 GOSUB 21000 '(more?) IF A$ = " "_ THEN 2110 IF BI=11 OR BI = 24_ 'user aborted THEN 2160 2109 LL = 3 PRINT CRLF$;STRING$(65,61);CRLF$;HEADER$;CRLF$;STRING$(65,45) 2110 PRINT STR$(M);TAB(9);LEFT$(DATE$,8);TAB(20);NO$;TAB(34);_ MSGTO$;" ";PERS$;TAB(48);MSGSUBJ$;" (";MID$(LE$,2);")" A$ = INKEY$ 2111 IF A$ <> ""_ THEN BI = ASC(A$) AND 31_ ELSE BI = 0 IF BI = 11 OR BI = 24_ 'user aborted THEN 2160 IF BI = 19_ 'user paused THEN A$ = INPUT$(1):_ GOTO 2111 LL = LL + 1 GOTO 1990 2160 PRINT PAST=0 CLOSE 1 RETURN '.pa '** Goodbye options 'Variables: ' A1$ = ' B$ = ' CRLF$ = carriage return, line feed ' GB = goodbye flag ' MSGSUBJ$ = message subject ' MKR = marker number in help file ' MPW$ = message password ' MSGTO$ = message to: ' UID = ' XPR = expert mode 2170 A1$=CRLF$+"Leave any comments? " IF XPR_ THEN A1$=A1$+"(Y/N/R):"_ ELSE A1$=A1$+CRLF$+"(Y)es/(N)o/(R)eturn to BBS:" GOSUB 2660 'print a$ or a1$ MKR=20 GOSUB 2750 'get command to b$ IF LEFT$(B$,1)="R"_ THEN RETURN IF LEFT$(B$,1)="Y"_ THEN GB=-1:_ MSGTO$="SYSOP":_ MPW$=".READ.":_ MSGSUBJ$="Exit Comment":_ UID=1:_ GOTO 751 2280 END '.pa '** Kill a message 'Variables: ' A1$ = ' B$ = ' BEL$ = bell ' CMSG$ = "Message" ' CRLF$ = carriage return, line feed ' DATE$ = date ' DEST$ = ' FL = ' FROM$ = ' G = ' I1$ = ' MSGSUBJ$ = message subject ' KIL = ' KKIL = ' KN = ' M = ' MSGNDX(n,n) = message array index ' MI = ' MKR = marker number in help file ' MPW$ = ' MZ = ' N$ = user's first name ' NA$ = user's full name ' O$ = user's last name ' OK = ' PERS = ' PW = ' RE = random record number ' RL = random record length ' RR$ = contents of random record ' S$ = ' SPCL = special user ' HIMSG = high message read ' UF$ = user's access level ' UID = user's id number ' WRTLOC = write lock 2290 IF INSTR("*MN",UF$)_ THEN 8000 A1$=CRLF$+CMSG$+" # to kill:" GOSUB 2660 'print a$ or a1$ MKR=5 GOSUB 2750 'get command to b$ IF LEN(B$)=0_ THEN M=0_ ELSE M=VAL(B$) 2310 IF M<1 OR M>HIMSG_ THEN PRINT:_ RETURN GOSUB 31000 'get message rec from index GOSUB 30030 'open message file RL=65 2330 GOSUB 3440 'test for private message IF OK=0_ THEN 2550 GET#1,RE GOSUB 3110 'clear trailing spaces PW=INSTR(S$,";") MPW$=MID$(S$,PW+1) GET#1,RE+1 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces DATE$=S$ IF UID=1_ THEN FL=-1 GET#1,RE+2 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces FROM$=S$ GET#1,RE+3 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces DEST$=S$ GET#1,RE+4 GOSUB 30050 'zero msg flags for display GOSUB 3110 'clear trailing spaces MSGSUBJ$=S$ IF KIL_ THEN 2470_ ELSE IF KKIL_ THEN 2400 PRINT CRLF$;"MSG#:";STR$(M);" DATE: ";DATE$ PRINT"FROM: ";FROM$;" TO: ";DEST$;" SUBJ: ";MSGSUBJ$ IF SPCL OR PERS_ THEN PERS=0:_ GOTO 2400 GET#1,RE+3 NA$=N$+" "+O$ GOSUB 3110 'clear trailing spaces IF INSTR(S$,NA$)<>0_ THEN 2470 A1$=CRLF$+"Password?" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ IF B$<>MPW$_ THEN PRINT "Password incorrect.";BEL$:_ GOTO 2555 2400 A1$="Kill this "+MSG$+"? (y/N):" GOSUB 2660 'print a$ or a1$ GOSUB 2750 'get command to b$ IF LEFT$(B$,1)<>"Y"_ THEN PRINT CMSG$;" retained.":_ GOTO 2555 2470 POKE WRTLOC,255 S$="0"+";"+STR$(M)+":"+N$+" "+O$ RL=65 GOSUB 3100 'place s$ in random buffer PUT #1,RE MSGNDX(1)=0 CLOSE 1 GOSUB 30010 'open counter file GET#1,1 LSET RR$=STR$(VAL(RR$)-1) PUT#1,1 CLOSE 1 GOSUB 30040 'open index file FOR I=2 TO MZ GET #1,I KN=CVI(I1$) IF KN=M_ THEN LSET I1$=MKI$(0):_ PUT #1,I:_ I=MZ NEXT IF FL_ THEN B$=MID$(STR$(M),2):_ NAME B$+".MF"+M1$ AS B$+".00"+M1$ PRINT CMSG$;" killed." POKE WRTLOC,0 GOTO 2555 2550 PRINT CMSG$;" not found." 2555 CLOSE 1 KIL=0 FL=0 KKIL=0 RETURN '.pa '** Find User Record ' This is a dual purpose routine to find user: ' For 'I' command or for message entry 'Variables: ' A1$ = ' A$ = ' BI = ' CRLF$ = carriage return, line feed ' DEST$ = ' I = loop counter ' MKR = marker number in help file ' MSG = ' MU$ = ' NN$ = ' NU = ' RR$ = contents of random record ' S$ = ' SU$ = ' UID = user's id number ' UF$ = ' ZZ = 2560 IF INSTR("*MN",UF$)_ THEN 8000 A1$=CRLF$+"Find which user? (C/R=all):" GOSUB 2660 'print a$ or a1$ MKR=21 GOSUB 2750 'get command to b$ GOSUB 2640 'print '^K to abort' 2570 GOSUB 30020 'open users file FIELD#1,1 AS MU$,1 AS SU$,76 AS RR$ FIELD#1,10 AS NN$ GET#1,1 NU=VAL(NN$) FOR I=2 TO NU GET#1,I IF (INSTR("*0",MU$)) AND MSG=0_ THEN 2620 'continue search loop IF MU$ = "0" AND MSG = 2_ THEN 2620 'continue search loop GOSUB 3110 'clear trailing spaces A$=LEFT$(S$,40) IF INSTR(A$,B$)=0_ THEN 2620 ZZ=LEN(A$) WHILE MID$(A$,ZZ,1)=" " ZZ=ZZ-1 WEND A$=LEFT$(A$,ZZ) DEST$=A$ IF MSG=2_ THEN UID=I:_ GOTO 2630_ ELSE GOSUB 2660 'print a$ or a1$ IF BI=11 OR BI=24_ 'abort with ^K/K/k/^X/X/x THEN 2630 2620 NEXT I 2630 CLOSE 1 RETURN '.pa '** Print A$ or A1$ string 'Variables: ' A$ = ' A1$ = ' BI = ' CRLF$ = carriage return, line feed ' LST = line printer flag ' N = ' PP$ = ' SAV$ = ' XPR = expert mode 2640 IF XPR_ THEN 2660 'print a$ or a1$ 2650 A$=CRLF$+"Enter ^K,K,k to abort, ^S,S,s to pause." 2660 BI=0 IF SAV$<>"" AND A1$<>""_ THEN A1$="":_ RETURN IF A1$<>""_ THEN A$=A1$:_ A1$="" IF (RIGHT$(A$,1)="?" OR RIGHT$(A$,1)=":" OR N=1)_ AND INLINE_ THEN PRINT A$;" ";:_ PP$=A$:_ GOTO 2740 'clear a$, n, and return A1$=INKEY$:_ IF A1$<>"" _ THEN BI=ASC(A1$) 2700 BI = BI AND 31 IF BI=19_ 'pause with ^S/S/s THEN BI=ASC(INPUT$(1)):_ GOTO 2700 IF BI=11 OR BI = 24_ 'abort with ^K/K/k/^X/X/x THEN PRINT:_ GOTO 2740 'clear a$, n, and return PRINT A$ '.pa IF LST_ THEN LPRINT A$ 2740 A$="" A1$="" N=0 RETURN '** Get commands from B$, check if stacked 'Variables: ' B$ = ' CAPS = capitalization flag ' SAV$ = ' SP = pointer 2750 B$="" IF SAV$=""_ THEN GOSUB 3500 'process input character SP=INSTR(SAV$,";") IF SP=0_ THEN B$=SAV$:_ SAV$="":_ GOTO 2800 B$=LEFT$(SAV$,SP-1) SAV$=MID$(SAV$,SP+1) 2800 IF B$ =""_ THEN RETURN IF CAPS=0_ THEN 2890 CALL UCASE(B$) 'capitalize b$ ' delete leading spaces from B$ 2890 ZZ = 1 WHILE MID$(B$,ZZ,1) = " " AND ZZ < LEN(B$) ZZ = ZZ + 1 WEND B$ = MID$(B$,ZZ) CAPS = 1 RETURN '.pa '** Error handler 'Variables ' CAPS = capitalization flag ' DUP = ' ERL = error line (reserved variable) ' ERR = error number (reserved variable) ' FL = ' HIMSG = high message read 2900 RESUME 2901 2901 IF ERL=3250_ 'display text file THEN FL=0:_ GOTO 3300 CLOSE IF ERL=260_ THEN HIMSG=0:_ GOTO 280 IF ERL=1510_ THEN CAPS=0:_ GOTO 1520 PRINT"Error";ERR;"occured on line";ERL DUP=-1 GOTO 520 '.pa '** Print user stats, prompt for new password 'Variables: ' A$ = ' ATO = auto message read mode ' B$ = ' HOMEBASE$ = User's home message base ' CRLF$ = carriage return, line feed ' I = loop counter ' LON$ = last on date ' M1$ = message base number ' MKR = marker number in help file ' N$ = user's first name ' NN = ' NN$ = ' NU = ' NULLS = number of nulls ' O$ = user's last name ' PAG = page pause mode ' PW$ = user's password ' RR$ = contents of random record ' SAV$ = ' ST$ = user's state ' UF$ = user's access level ' UP$ = user's parameters ' UR = user id number ' UR$ = user id number ' XPR = expert user mode ' WRTLOC = write lock 2950 I=VAL(UR$) PRINT CRLF$;"Your USER ID# is";I NN=PEEK(NULLS) PRINT MID$(STR$(NN),2); " nulls" PRINT "Auto-Read";MODE$;" is "; IF ATO_ THEN PRINT"on."_ ELSE PRINT"off." IF XPR_ THEN PRINT"Expert";_ ELSE PRINT"Novice"; PRINT MODE$;" is on." PRINT "Page pause";MODE$;" is "; IF PAG_ THEN PRINT "on."_ ELSE PRINT "off." '.pa IF HOMEBASE$<>"W"_ THEN PRINT "Home base is file # ";HOMEBASE$ 3020 NN$=STR$(NN) UP$=RIGHT$(NN$,1) IF XPR_ THEN UP$=UP$+"X"_ ELSE UP$=UP$+"x" IF ATO_ THEN UP$=UP$+"P"_ ELSE UP$=UP$+"p" IF PAG_ THEN UP$=UP$+"T"_ ELSE UP$=UP$+"t" UP$=UP$+HOMEBASE$ UP$=RIGHT$(UP$,5) B$=M1$ M1$="1" GOSUB 30020 FIELD#1,78 AS RR$ M1$=B$ GET #1,I 3060 PW$=MID$(RR$,51,4) PRINT "Your password is ";PW$ A$="Enter new password (C/R=same):" MKR=15 GOSUB 2660 GOSUB 2750 IF LEN(B$)=0_ THEN 3090 IF LEN(B$)<>4_ THEN 3060_ ELSE PW$=B$ 3090 POKE WRTLOC,255 MID$(RR$,46,9)=UP$+PW$ PUT #1,I CLOSE 1 POKE WRTLOC,0 A$="O" GOSUB 30015 WRITE #1,N$,O$,UF$,UR$,PW$,ST$,UP$,LON$ CLOSE 1 RETURN '.pa '** Fill with spaces and place in random buffer 'Variables: ' CRLF$ = carriage return, line feed ' RL = length of random record ' RR$ = contents of random record ' S$ = 3100 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CRLF$ RETURN '** Clear trailing spaces 'Variables: ' RR$ = contents of random record ' ZZ = ' S$ = 3110 ZZ=LEN(RR$)-2 WHILE MID$(RR$,ZZ,1)=" " AND ZZ>1 ZZ=ZZ-1 WEND 3130 S$=LEFT$(RR$,ZZ) IF RIGHT$(S$,1)="?"_ THEN S$=S$+" " RETURN '.pa '** Change user parameters 'Variables: ' A1$ = ' ATO = auto message read mode ' B$ = ' HOMEBASE$ = User's home message base ' CRLF$ = carriage return, line feed ' MKR = marker number in help file ' NULLS = number of nulls ' PAG = page pause mode ' XPR = expert user mode 3150 A1$=CRLF$+"Enter number of nulls (0-9):" GOSUB 2660 'print a$ or a1$ MKR=10 GOSUB 2750 'get command to b$ IF B$=""_ THEN RETURN IF VAL(B$)<0 OR VAL(B$)>9_ THEN 3150 'set nulls POKE NULLS,VAL(B$) RETURN 3170 XPR=NOT(XPR) PRINT IF XPR_ THEN PRINT "Expert";MODE$_ ELSE PRINT "Novice";MODE$ RETURN 3190 ATO=NOT(ATO) PRINT CMGS$;"Auto-Read";MODE$;" is "; IF ATO_ THEN PRINT "on."_ ELSE PRINT "off." RETURN 3204 PAG=NOT(PAG) PRINT "Page Pause";MODE$;" is "; IF PAG_ THEN PRINT "on."_ ELSE PRINT "off." RETURN 3208 A1$=CRLF$+"Enter home base file number:" GOSUB 2660 'print a$ or a1$ MKR=11 GOSUB 2750 'get command to b$ IF B$=""_ THEN RETURN IF VAL(B$)<0 OR VAL(B$)>6_ THEN 3208 'set home base IF B$= "0"_ THEN B$ = "W" HOMEBASE$=B$ RETURN '.pa '** Display a text file 'Variables: ' A$ = ' B1$ = ' BI = ' DRIVES$ = drive assignment ' FIL$ = file name to print ' L = lines printed (page pause) ' PAG = page pause mode 3250 OPEN "I",2,DRIVE$+FIL$ INLINE = 0 'allows trailing : or ? IF FL = -1_ 'use with (more?) pause THEN LL = 6_ ELSE LL = 1 3260 IF EOF(2)_ THEN 3300 LINE INPUT #2,A$ IF LEFT$(A$,4)="----" AND DASHFILE_ THEN IF NOT(FIRSTPAGE)_ THEN WHILE LL < PAGLEN - 1:_ PRINT:_ LL = LL + 1:_ WEND:_ ELSE FIRSTPAGE = 0_ ELSE GOSUB 2660 LL = LL + 1 IF LL MOD PAGLEN = 0 AND PAG <> 0_ THEN GOSUB 21000 '(more?) IF BI = 11 OR BI = 24_ 'abort with ^K/K/k/^X/X/x THEN 3300 GOTO 3260 3300 FIRSTPAGE = -1 INLINE = -1 DASHFILE = 0 CLOSE 2 RETURN '.pa '** Test for private message 'Variables: ' N$ = user's first name ' O$ = user's last name ' OK = ' PERS = ' PERS$ = ' RE = random record number ' RR$ = contents of random record ' SPCL = special user ' UN$ = ' UO$ = ' ZN$ = ' Z0$ = 3440 PERS$="" PERS=0 OK=-1 IF MRE>=MX THEN PAST=-1:RETURN GET #1,MRE M=VAL(RR$) RE=MRE TEMP$=RR$ GET #1,RE+5:MRE=RE+VAL(RR$)+6 IF INSTR(TEMP$,";.READ.")=0_ THEN RETURN PERS$="*" PERS=-1 IF SPCL THEN_ RETURN GET #1,RE+3 ZN$=UN$ ZO$=UO$ GOSUB 3480 'set ok flag IF OK_ THEN RETURN GET #1,RE+2 ZN$=N$ ZO$=O$ GOSUB 3480 'set ok flag RETURN '.pa 3480 IF INSTR(RR$,ZN$)>0 AND INSTR(RR$,ZO$)>0_ THEN OK=-1_ ELSE OK=0 RETURN '.pa '** Process each character input 'Variables: ' BEL$ = bell ' CHC = ' DUP = ' ERS$ = eraseable backspace ' F = line number in message ' INS = ' KEY = ' MKR = marker number in help file ' NCH = ' SAV$ = 3500 CHC=0 SAV$="" 3510 NCH=ASC(INPUT$(1)) IF NCH<32 OR NCH=127_ THEN 3590 IF NCH=63 AND CHC=0 AND MKR>0_ THEN PRINT:_ GOTO 13000 IF CHC=63 AND INS AND KEY_ THEN 3530 IF CHC=63 AND NCH=32 AND KEY_ THEN PRINT:_ CHC=0:_ RETURN IF CHC=63 AND NCH<>32 AND KEY_ THEN SAV$=SAV$+CHR$(NCH):_ GOSUB 30000:_ 'word wrap RETURN 3530 IF CHC=63_ THEN PRINT BEL$;:_ GOTO 3510 'process character input SAV$=SAV$+CHR$(NCH) CHC=CHC+1 IF DUP_ THEN PRINT CHR$(NCH); GOTO 3510 'process character input '.pa 3570 IF CHC=0_ THEN 3510_ 'process character input ELSE PRINT ERS$; 3580 IF CHC=0_ THEN 3510_ 'process character input ELSE CHC=CHC-1:_ SAV$=LEFT$(SAV$,CHC):_ GOTO 3510 'process character input '** Process control characters 'Variables: ' BCC = loop counter ' CHC = ' DUP = ' ERS$ = eraseable backspace ' NCH = ' SAV$ = ' TP = 3590 IF NCH=127_ THEN NCH=8 IF NCH=8 AND DUP_ THEN 3570 IF NCH=4_ THEN DUP=NOT(DUP) IF NCH=8_ THEN 3580 IF NCH=9_ THEN IF DUP_ THEN 3770_ ELSE PRINT CHR$(NCH);:_ GOTO 3510 'process character input IF NCH=13_ THEN PRINT:_ RETURN IF NCH<>24 OR CHC=0_ THEN 3510 'process character input FOR BCC=1 TO CHC PRINT ERS$; NEXT BCC GOTO 3500 3770 TP=(CHC AND 248)+8-CHC PRINT SPACE$(TP); SAV$=SAV$+SPACE$(TP) CHC=CHC+TP GOTO 3510 'process character input RETURN '** Clear trailing spaces 'Variables: ' TEMP$ = 4390 IF RIGHT$(TEMP$,1)=" "_ THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):_ GOTO 4390 RETURN '** Pass NEW MESSAGE string to B$ 'Variables: ' A$ = ' B$ = ' D1 = ' LM = ' M = 6000 D1=-1 M=LM+1 B$=STR$(M)+"+" A$="" GOTO 1650 '** Insufficient access for requested function. 'Variables: ' CRLF$ = Carriage return, line feed 8000 PRINT CRLF$;"Sorry, insufficient access." RETURN '.pa '** Show version of QRUN that we are running. 'Variables: ' VERS$ = version 8100 PRINT CRLF$;"Current software revision is: ";VERS$;CRLF$ RETURN '** Direct move to a message file selected with 1-6. 'Variables: 'MFILE$ = message file name 'UF$ = user access level 'B$ = 'M1$ = message file 8900 IF MFILE$(VAL(B$)) = " "_ THEN 580 IF B$ = "6"_ THEN IF INSTR("+$S",UF$)_ THEN M1$ = B$:_ GOTO 8910_ ELSE 580 8910 M1$ = B$ GOTO 9020 '.pa '** Move up or down one message base ('>', '<' commands) 'Variables: ' CRLF$ = Carriage return, line feed ' M1$ = Message base number ' TM$ = Stores M1$ - TR MOD ' MFILE$(n) = Name of message base ' UF$ = User access level ' SPCL = Special User 9000 TM$=M1$ 9005 IF M1$="6"_ THEN 9030 M1$=MID$(STR$(VAL(M1$)+1),2) IF INSTR("+$S",UF$)=0 AND M1$="6"_ THEN 9030 IF MFILE$(VAL(M1$))=" "_ THEN 9005 GOTO 9020 9010 TM$=M1$ 9015 IF M1$="1"_ THEN 9030 M1$=MID$(STR$(VAL(M1$)-1),2) IF MFILE$(VAL(M1$))=" "_ THEN 9015 9020 PRINT CRLF$;"Moving to ";MFILE$(VAL(M1$)) GOTO 10020 9030 M1$=TM$:_ RETURN '.pa '** Choose a message file 'Variables: ' A1$ = temporary string to print ' B$ = User input (from subroutine) ' CMSG$ = "Message" ' CRLF$ = Carriage return, line feed ' D1 = ' FIL$ = File name to print ' FPW$ = ' I = loop counter ' LON$ = Last On ' M1$ = Message base number ' MFG = ' MFILE$(n) = Name of message base ' MKR = marker number in help file ' ML1$ = ' PW$ = user's password ' SPCL = Special User ' UF$ = User access level '** Choose a message file 10000 IF M1$="1" AND LON$="--"_ THEN 10030 MFG=0 A1$=CRLF$+CMSG$+" files are:"+CRLF$+CRLF$ FOR I=1 TO 5 IF MFILE$(I)<>" "_ THEN A1$=A1$+STR$(I)+" "+MFILE$(I)+CRLF$ NEXT I IF INSTR("+$S",UF$)_ THEN A1$=A1$+" 6 "+MFILE$(6)+CRLF$ 10010 A1$=A1$+CRLF$+"Select file (RETURN for Descriptions):" GOSUB 2660 'print a$ or a1$ MKR=7 GOSUB 2750 'get command to b$ IF B$=""_ THEN FIL$="FILE-DES":_ GOSUB 3250:_ 'display text file GOTO 10000 IF LEN(B$)>1_ THEN 10010 M1$=B$ '.pa IF VAL(M1$)<1 OR VAL(M1$)>6_ THEN 10010 10020 IF M1$<"6"_ THEN MFILE$=MFILE$(VAL(M1$)) IF INSTR("+$S",UF$) AND M1$="6"_ THEN MFILE$=MFILE$(6)_ ELSE IF M1$="6"_ THEN 10010 10030 IF MFILE$=" "_ THEN 10000 D1=-1 ML1$="" FPW$=PW$ '.pa '** Login to new message file 'Variables: ' B$ = ' CN! = caller number ' DATE$ = date ' D1 = counter ' FPW$ = ' I = loop counter ' LM = ' LM$ = ' LON$ = last on date ' M = ' M$ = ' N$ = user's first name ' NA$ = ' NN$ = ' NU = ' O$ = user's last name ' PW$ = user's password ' QQ = ' QR = ' RL = random record length ' RR$ = contents of random record ' S$ = ' ST$ = user's state ' UF$ = user's access level ' UP$ = user's parameters ' HIMSG = high message read ' UR = ' UU$ = ' URF = ' V = ' WRTLOC = write lock GOSUB 20000 'get and format date GOSUB 30010 'open counter file D1=0 '** COUNTER GET#1,1 M=VAL(RR$) GET#1,2 CN!=VAL(RR$)+1 'increment caller number LSET RR$=MID$(STR$(CN!),2) 'and save it to disk PUT#1,2 '.pa GET#1,3 HIMSG=VAL(RR$) CLOSE 1 UU$=RIGHT$("000"+MID$(STR$(HIMSG),2),4) NA$=N$+" "+O$ URF=0 V=0 RL=78 GOSUB 30020 FIELD#1,78 AS RR$ POKE WRTLOC,255 GET#1,1 NU=VAL(RR$) FOR I=2 TO NU+1 GET#1,I B$=LEFT$(RR$,44) M$=LEFT$(RR$,1): IF M$="0"_ THEN UR=I:_ URF=-1:_ GOTO 10040 IF INSTR(B$,NA$)=0_ THEN 10040 NN$=MID$(RR$,3) QQ=INSTR(NN$," ") N$=LEFT$(NN$,QQ-1) NN$=MID$(NN$,QQ+1) QQ=INSTR(NN$," from") O$=LEFT$(NN$,QQ-1) NN$=MID$(NN$,QQ+6) QR=INSTR(NN$," ") ST$=LEFT$(NN$,QR-1) UF$=LEFT$(RR$,1) IF M1$="1" THEN _ UP$=MID$(RR$,46,5) : _ PW$=MID$(RR$,51,4) LM$=MID$(RR$,55,4) MID$(RR$,55,4)=UU$ LON$=MID$(RR$,59,17) MID$(RR$,59,17)=DATE$ PUT #1,I CLOSE 1 '.pa UR=I LM=VAL(LM$) GOTO 10050 10040 NEXT I M$=UF$ UP$="0xPTW" S$=M$+" "+N$+" "+O$+" from "+ST$ RL=78 GOSUB 3100 'place s$ in random buffer MID$(RR$,46,5)=UP$ MID$(RR$,51,4)=FPW$ MID$(RR$,55,4)=UU$ MID$(RR$,59,17)=DATE$ IF URF_ THEN PUT #1,UR_ ELSE NU=NU+1:_ PUT#1,NU:_ UR=NU IF M1$="1"_ THEN UR$=STR$(UR) '** ADDED S$=STR$(NU) GOSUB 3100 'place s$ in random buffer PUT#1,1 CLOSE 1 LON$="--" UF$=M$ 10050 GOSUB 30060 'check for sysop, set flag '.pa '** Write callers file, bypass for $SYSOP 'Variables: ' DATE$ = date ' DRIVE$ = drive assignment ' M1$ = message base number ' N$ = user's first name ' O$ = user's last name ' RE = ' RL = random record length ' RR$ = contents of random record ' S$ = ' ST$ = user's state ' UF$ = user's access level ' WRTLOC = write lock IF UF$="$"_ THEN POKE WRTLOC,0:_ GOTO 280 OPEN "R",1,DRIVE$+"CALLERS"+M1$,65 FIELD#1,65 AS RR$ GET#1,1 RE=VAL(RR$)+1 S$=STR$(RE) RL=65 GOSUB 3100 'place s$ in random buffer PUT#1,1 RE=RE+1 S$=N$+" "+O$+" from "+ST$+" "+DATE$+" ("+STR$(PEEK(&H3C))+")" GOSUB 3100 'place s$ in random buffer PUT#1,RE CLOSE 1 POKE WRTLOC,0 GOTO 280 '.pa '** Print callers file 'Variables: ' A$ = ' BI = character input ' CRLF$ = carriage return, line feed ' I = loop counter ' M1$ = message base number ' RR$ = contents of random file record ' S$ = ' UF$ = user access ' ZZ = temporary integer 12000 IF INSTR("+$S",UF$)=0_ THEN RETURN PRINT CRLF$ OPEN "R",1,DRIVE$+"CALLERS"+M1$,65 FIELD #1,65 AS RR$ GET #1,1 ZZ=VAL(RR$) FOR I=ZZ+1 TO 2 STEP -1 GET #1,I GOSUB 3110 'clear trailing spaces A$=S$ GOSUB 2660 'print a$ or a1$ IF BI=11_ '^K abort display THEN I=2 NEXT I CLOSE 1 RETURN '.pa '** Process help markers. MKR=marker number in help file 'Variables: ' B$ = ' DRIVE$ = drive assignment ' FIL$ = file name ' MKR = marker number in help file ' PP$ = 13000 IF MKR=81_ THEN GOSUB 2640:_ 'print '^K to abort' FIL$="MENU-HLP":_ GOTO 3250 'display text file IF MKR=82_ THEN GOSUB 2640:_ 'print '^K to abort' FIL$="EDIT-HLP":_ GOTO 3250 'display text file OPEN "I", 2, DRIVE$+"MORE-HLP" 13030 LINE INPUT #2,B$ IF B$<>MID$(STR$(MKR),2)+":"_ THEN 13030 13050 PRINT MID$(B$,7) LINE INPUT #2,B$ IF B$=MID$(STR$(MKR+1),2)+":"_ THEN CLOSE 2:_ PRINT:_ PRINT PP$+" ";:_ GOTO 3510 'process character input IF EOF(2)_ THEN CLOSE 2:_ RETURN_ ELSE 13050 '.pa '** Setup for User Comment 'Variables: ' I1$ = ' I2$ = ' MSGSUBJ$ = message subject ' MPW$ = ' MX = ' MZ = ' MSGTO$ = Message To: ' UID = addressee user id number 15000 GOSUB 30040 'open index file GET #1,1 MZ=CVI(I1$) MX=CVI(I2$) CLOSE 1 MSGTO$="SYSOP" MPW$=".READ." MSGSUBJ$="User Comment" UID=1 GOTO 751 '** Timecheck on, WRTLOC off (After message is written to disk) 'Variables: ' MXML = ' SMX = ' WRTLOC = 17000 POKE MXML,SMX POKE WRTLOC,0 RETURN '** Close and delete temp file 'Variables: ' RR1$ = input line buffer 18000 CLOSE 3 KILL "QMSG.$$$" RR1$ = "" RETURN '** Get time and date 'line number series 20000 %INCLUDE QTIME.INC '.pa '** (More?) pause. Entering ^N/N/n will abort, a space will ' advance one line, anything else will return the response in ' BI for handling by calling routine 21000 PRINT " (more?) "; A$ = INPUT$(1) IF A$ <> ""_ THEN BI = ASC(A$) AND 31 FOR J5 = 1 TO 9:_ PRINT ERS$;:_ NEXT J5 IF BI = 14_ 'user entered 'N' THEN BI = 11 'abort IF A$ = " "_ 'user entered THEN LL = LL -1_ ELSE LL = 1_ RETURN '** Word wrap routine 'Variables: ' LN = line length ' K = line length ' WW$ = ' C$ = ' SAV$ = ' ERS$ = erasable backspace 30000 LN=64 K=LN WW$="" 30004 K=K-1 C$=MID$(SAV$,K,1) PRINT ERS$; IF C$=" "_ THEN PRINT:_ WW$=RIGHT$(SAV$,LN-K):_ SAV$=LEFT$(SAV$,K):_ RETURN GOTO 30004 RETURN '.pa '** Open various system files 'Variables: ' DRIVE$ = drive assignment ' M1$ = message file number ' RR$ = contents of random record ' I1$ = ' I2$ = ' I3$ = 30010 OPEN "R",1,DRIVE$+"COUNTER"+M1$,5 FIELD #1,5 AS RR$ RETURN 30015 OPEN A$,1,DRIVE$+"LCALLER" RETURN 30020 OPEN "R",1,DRIVE$+"USERS"+M1$,78 RETURN 30030 OPEN "R",1,DRIVE$+"MESSAGE"+M1$,65 FIELD #1,65 AS RR$ RETURN 30040 OPEN "R",1,DRIVE$+"MF"+M1$+"-REC",6 '** Index file FIELD #1,2 AS I1$,2 AS I2$,2 AS I3$ RETURN '** Check for message flags and erase them for message display 'Variables: 'RR$ = contents of random record 'UID = user id number 30050 UID=VAL(MID$(RR$,56,6)) MID$(RR$,56,6)=" " RETURN '.pa '** Check for sysop and flag 'Variables: ' UF$ = user access level ' SPCL = special user 30060 IF INSTR("$+",UF$)_ THEN SPCL=-1_ ELSE SPCL=0 RETURN '** Read Message Index file. 31000 GOSUB 30040 IF M>MID _ THEN J=MIDRE IF M=M_ THEN MRE=MSGNDX(2):_ CLOSE 1:_ RETURN NEXT MRE=0 CLOSE 1 RETURN '.pa