10  REM:  BANNER: Banner supervisor program
20  REM:
30  REM:  Written by Dan Kohn, modified by David Shayer
40  REM:  Overhauled by Brad Zaller  SMHS  9/2/81
50  REM:
110  FILES *,*,*
120  DIM A$[80],A0$[10],A1$[10],B$[80],C$[80],F$[100],F1$[11],I$[150]
130  REM:  In the next line, A0$ must be set to the account in
140  REM:  which the LOG file resides.
150  A0$="A101"
160  REM:  In the next line, A1$ must be set to the account in
170  REM:  which the banner text files will reside.
180  A1$="A102"
190  REM:  F$ holds the name of the banner text file (Port/Account)
200  REM:  F1$ holds the name of the banner scratch file.
210  SYSTEM A$,"TIM"
220  ENTER #P
240  IF POS("A0A1X0X1Q4",A$[1,2]) <> 0 THEN 270
250  CHAIN B5,"$HELLO",350
260  STOP 
270  F1$="BSCR"
280  F1$[5]=A$[15,16]
290  F1$[7]="."
300  F1$[8]=A0$
310  CREATE X,F1$,5
320  GOTO X+1 OF 390,390,370,330,350
330  PRINT "No space on ";A0$;" - Cannot continue."'7
340  STOP 
350  PRINT "No space on system - Cannot continue"'7"."
360  STOP 
370  PRINT "Due to file accessability, this program must be"
371  PRINT "executed, not run."
380  STOP 
390  ASSIGN F1$,1,K
400  IF K=0 THEN 430
410  PRINT '7"Error - Scratch file ";F1$;" in use - Cannot continue."'7
420  STOP 
430  REM:  The BREAK key must be disabled due to the sensitivity of
431  REM:  the security system.  An aborted banner could be fatal.
439  REM K=BRK(0)
440  PRINT LIN(1);"*** Banner ***";LIN(1)
690  PRINT LIN(1);"Command: ";
700  INPUT A$
710  B$=UOS$(A$)
770  IF B$="" THEN 690
780  IF B$[1,3]="//S" THEN 4960
785  IF B$[1,3]="//R" THEN 5000
790  IF B$[1,3]#"//H" THEN 820
791  PRINT LIN(1);"   Valid banner options:";LIN(1)
792  PRINT "   (A)dd      - Adds a banner into the system"
793  PRINT "   (D)ump     - Dumps the labels of all banners"
794  PRINT "   (L)ist     - List the text of a given banner"
795  PRINT "   (K)ill     - Removes a banner from the system"
796  PRINT "   (S)tatus   - Prints the status of a given banner";LIN(1)
797  PRINT "   (//R)epgen - Turns control over to the REPGEN program"
798  PRINT "   (//S)top   - Exits this program"
799  ASSIGN "INFOB.A101",2,R,"CONTROL"
800  IF R THEN 690
801  IF  END #2 THEN 690
802  READ #2;B$
803  PRINT LIN(1);"Continue? ";
804  LINPUT A$
805  A$=UOS$(A$)
806  IF A$[1,3]="//S" THEN 4960
807  IF A$[1,1]#"Y" THEN 690
808  PRINT LIN(1);TAB(20);"Banner info file updated: ";B$;LIN(1)
809  READ #2;I$
810  PRINT I$
811  IF SYS(3) THEN 690
819  GOTO 809
820  P=POS("LKSDA",B$[1,1])
822  IF P THEN 830
824  PRINT "Invalid command"
826  GOTO 690
830  C=P
840  IF P=5 THEN 2910
850  IF P=4 THEN 1620
860  P=POS(B$,"-")
861  IF P AND P#LEN(B$) THEN 900
863  PRINT "Account: ";
864  LINPUT B$
865  B$=UOS$(B$)
866  A$[2]="-"
867  A$[3]=B$
868  IF LEN(B$)=0 THEN 690
900  A$=B$[P+1]
910  GOSUB 2120
920  IF E=0 THEN 950
930  PRINT A$;": Illegal banner name"
940  GOTO 690
950  ASSIGN F$,2,K
960  GOTO K+1 OF 1020,1000
970  GOSUB 1820
980  PRINT F$[1,POS(F$,".")-1];": No such banner"
990  GOTO 690
1000  PRINT F$[1,POS(F$,".")-1];": Banner file busy - Try later."
1010  GOTO 690
1020  GOSUB C OF 1040,1140,1230
1030  GOTO 690
1040  REM ***** List a banner *****
1050  GOSUB 1230
1060  IF E THEN 1130
1070  PRINT LIN(1);"Contents:";LIN(1)
1080  IF  END #2 THEN 1120
1090  READ #2;I$
1100  PRINT "** ";I$
1105  READ #2;I$
1107  PRINT "   ";I$
1110  GOTO 1105
1120  PRINT 
1130  RETURN 
1140  REM ***** Remove a banner *****
1150  ASSIGN *,2
1160  PURGE X,F$
1170  IF X THEN 1210
1180  GOSUB 1820
1190  PRINT F$[1,POS(F$,".")-1];": Banner removed"
1200  RETURN 
1210  PRINT F$[1,POS(F$,".")-1];": Purge error - Banner NOT"'7" removed."
1220  RETURN 
1230  REM ***** Status *****
1240  E=0
1250  RESTORE 1260
1260  DATA "Expiration","Time"
1270  ASSIGN F$,2,K
1280  IF  END #2 THEN 1350
1290  READ #2;T
1300  IF ABS(T-1)=INT(T-1) AND T<3 THEN 1370
1310  CONVERT T TO A$
1320  PRINT F$[1,POS(F$,".")-1];" has an illegal classification ("A$")."
1330  E=1
1340  RETURN 
1350  PRINT F$[1,POS(F$,".")-1];" is blank."
1360  GOTO 1330
1370  IF  END #2 THEN 1590
1380  IF T=2 THEN 1410
1390  READ #2;N,S
1400  GOTO 1420
1410  READ #2;D,Y,H
1420  FOR X=1 TO T
1430  READ A$
1440  NEXT X
1450  PRINT LIN(1);"Type: ";A$;". ";
1460  IF T=2 THEN 1540
1470  CONVERT N TO A$
1480  CONVERT S TO B$
1490  C$="s"
1500  IF N>1 THEN 1520
1510  C$=""
1520  PRINT "Will expire after "A$" use"C$".  Status: ";B$
1530  RETURN 
1540  CONVERT D TO A$
1550  CONVERT Y TO B$
1560  CONVERT H TO C$
1570  PRINT "Expiration date (JJJ/YY,HHMM): "A$"/"B$","C$"."
1580  RETURN 
1590  PRINT F$[1,POS(F$,".")-1];" doesn't have the needed data."
1600  E=1
1610  RETURN 
1620  REM ****** Dump all banner titles *****
1630  F$="LOG."
1640  F$[LEN(F$)+1]=A0$
1650  ASSIGN F$,2,R,"HAN"
1660  IF R<3 THEN 1700
1670  ASSIGN *,2
1680  PRINT '7"Flag file assign error - command aborted."'7
1685  SYSTEM X,"MES-"'7":::ASSIGN ERROR:::LOG FILE:::BANNER:::"'7
1690  GOTO 690
1700  IF  END #2 THEN 1790
1710  PRINT LIN(1);"Current banners:"
1720  READ #2,100;E
1730  FOR X=1 TO E
1740  READ #2;F$
1750  IF F$[7,7]=" " THEN 1770
1760  PRINT F$[1,6]
1770  NEXT X
1780  GOTO 690
1790  ASSIGN *,2
1800  PRINT '7"File format error (Flag file) - Command aborted."'7
1805  SYSTEM X,"MES-"'7":::FILE FORMAT ERROR:::FLAG FILE:::BANNER:::"'7
1810  RETURN 
1820  REM ***REMOVE FLAG FROM FLAG FILE***
1830  I$="LOG."
1840  I$[LEN(I$)+1]=A0$
1850  ASSIGN I$,2,R,"HAN"
1860  IF R=0 THEN 1900
1870  ASSIGN *,2
1880  PRINT '7"Flag file assign error - Command aborted."'7
1885  SYSTEM X,"MES-"'7":::ASSIGN ERROR:::FLAG FILE:::BANNER:::"'7
1890  RETURN 
1900  LOCK #2,R
1910  IF R THEN 1900
1920  IF  END #2 THEN 2090
1930  READ #2,100;E
1940  FOR X=1 TO E
1950  READ #2;I$
1960  IF I$[1,1]=" " THEN 2060
1970  IF I$[1,POS(I$," ")-1 MIN 6]#F$[1,POS(F$,".")-1] THEN 2060
1980  IF NUM(I$[8,8])#32 OR NUM(I$[15,15])#32 THEN 2020
1990  FOR Z=1 TO 25
2000  I$[Z,Z]=" "
2010  NEXT Z
2020  I$[7,7]=" "
2030  READ #2,100
2040  ADVANCE #2;X,R
2050  UPDATE #2;I$
2060  NEXT X
2070  ASSIGN *,2
2080  RETURN 
2090  ASSIGN *,2
2100  PRINT '7"File format error (Flag file) - Command aborted."'7
2105  SYSTEM X,"MES-"'7":::FILE FORMAT ERROR:::FLAG FILE:::BANNER:::"'7
2110  RETURN 
2120  REM ***** Check for legal banner name *****
2130  E=0
2140  IF LEN(A$)>6 THEN 2450
2150  IF A$="ALL" THEN 2410
2160  IF NUM(A$)>47 AND NUM(A$)<58 THEN 2230
2170  IF NUM(A$)<65 OR NUM(A$)>90 THEN 2450
2180  IF LEN(A$)>4 THEN 2450
2190  FOR X=2 TO LEN(A$)
2200  IF NUM(A$[X,X])<48 OR NUM(A$[X,X])>57 THEN 2450
2210  NEXT X
2220  GOTO 2410
2230  IF LEN(A$)=1 THEN 2300
2240  IF NUM(A$[2,2])>47 AND NUM(A$[2,2])<58 THEN 2340
2250  IF NUM(A$[2,2])<65 OR NUM(A$[2,2])>90 THEN 2450
2260  IF LEN(A$)>5 THEN 2450
2270  FOR X=3 TO LEN(A$)
2280  IF NUM(A$[X,X])<48 OR NUM(A$[X,X])>57 THEN 2450
2290  NEXT X
2300  F$=A$
2310  A$="0"
2320  A$[2]=F$
2330  GOTO 2410
2340  IF LEN(A$)=2 THEN 2410
2350  IF NUM(A$[3,3])<65 OR NUM(A$[3,3])>90 THEN 2450
2360  IF LEN(A$)=3 THEN 2410
2370  IF LEN(A$)>6 THEN 2450
2380  FOR X=4 TO LEN(A$)
2390  IF NUM(A$[X,X])<48 OR NUM(A$[X,X])>57 THEN 2450
2400  NEXT X
2410  F$=A$
2420  F$[LEN(F$)+1]="."
2430  F$[LEN(F$)+1]=A1$
2440  RETURN 
2450  E=1
2460  RETURN 
2470  REM ***** Check for duplicate banner *****
2480  GOSUB 2120
2490  IF E THEN 2890
2500  CREATE X,F$,1
2510  I$="MWA-"
2520  I$[5]=F$
2530  SYSTEM Z9,I$
2540  GOTO X+1 OF 2570,2650
2550  PURGE Y,F1$
2560  GOTO X-1 OF 370,330,350
2570  ASSIGN F$,2,K
2580  E=0
2590  IF K=0 THEN 2640
2600  PRINT '7"Assign error - Banner NOT"'7" created."'7
2610  E=1
2620  ASSIGN *,2
2630  PURGE X,F$
2640  RETURN 
2650  REM ***** Duplicate banner *****
2660  PRINT F$[1,POS(F$,".")-1];": Duplicate entry"
2670  PRINT "List? ";
2680  LINPUT A$
2690  A$=UOS$(A$)
2700  IF A$[1,3]="//S" THEN 4960
2710  IF A$[1,3]#"//H" THEN 2750
2720  PRINT "A banner already exists under the title '"F$[1,POS(F$,".")]"'."
2730  PRINT "If you would like to see its text type 'YES'."
2740  GOTO 2670
2750  IF A$[1,1]#"Y" THEN 2770
2760  GOSUB 1040
2770  PRINT LIN(1);"Remove? ";
2780  LINPUT A$
2790  A$=UOS$(A$)
2800  IF A$[1,3]="//S" THEN 4960
2810  IF A$[1,3]#"//H" THEN 2850
2820  PRINT "If you would like to remove the banner '"F$[1,POS(F$,".")-1]"' from"
2830  PRINT "the system so you can replace it with another one,"
2835  PRINT "type 'Yes'."
2840  GOTO 2770
2850  IF A$[1,1]#"Y" THEN 2870
2860  GOSUB 1140
2870  E=1
2880  RETURN 
2890  PRINT B$;": Illegal banner name"
2900  RETURN 
2910  REM ***** Baner creation *****
2920  PRINT LIN(1);"Account: ";
2930  LINPUT B$
2935  B$=UOS$(B$)
2940  IF LEN(B$)=0 THEN 690
2950  IF B$[1,3]="//S" THEN 4960
2960  IF A$[1,3]#"//H" THEN 3000
2970  PRINT "Enter the account, port, or combination of port/account"
2980  PRINT "that you want to put the banner on.  'All' is also valid."
2990  GOTO 2920
3000  P=POS(B$,"-")
3010  IF P AND P#LEN(B$) THEN 3840
3020  A$=B$
3030  GOSUB 2470
3040  IF E THEN 690
3050  PRINT "   Type: ";
3060  LINPUT A$
3070  A$=UOS$(A$)
3080  IF A$[1,3]#"//S" THEN 3110
3090  GOSUB 1140
3100  GOTO 4960
3110  IF A$#"" THEN 3140
3120  GOSUB 1140
3130  GOTO 690
3140  IF A$[1,3]#"//H" THEN 3170
3150  PRINT "   Type can be either (E)xpiration or (T)ime."
3160  GOTO 3050
3170  T=POS("ET",A$[1,1])
3180  IF T THEN 3210
3190  PRINT A$;": Illegal Type"
3200  GOTO 3150
3210  IF T=2 THEN 3550
3220  REM ***** Expiration type banner *****
3230  PRINT "Number of uses: ";
3240  LINPUT A$
3250  A$=UOS$(A$)
3260  IF A$[1,3]#"//S" THEN 3290
3270  GOSUB 1140
3280  GOTO 4960
3290  IF A$#"" THEN 3320
3300  GOSUB 1140
3310  GOTO 690
3320  IF A$[1,3]#"//H" THEN 3350
3330  PRINT " Enter the number of times the banner should be displayed before"
3335  PRINT " it expires."
3340  GOTO 3230
3350  CONVERT A$ TO N,5101
3360  IF ABS(N-1)=INT(N-1) THEN 3410
3370  PRINT A$;": Meaningless figures"
3380  GOTO 3230
3390  PRINT "Type digits only"
3400  GOTO 3230
3410  PRINT "Status: ";
3420  LINPUT A$
3430  A$=UOS$(A$)
3440  IF A$[1,3]#"//S" THEN 3470
3450  GOSUB 1140
3460  GOTO 4960
3470  IF A$[1,3]#"//H" THEN 3500
3480  PRINT "  -2 to logoff bannered user; Anything else won't."
3490  GOTO 3410
3500  CONVERT A$ TO S,5250
3510  S=S*(S=-2)
3520  GOTO 4160
3530  S=0
3540  GOTO 4160
3550  REM ***** Time type banner *****
3560  PRINT "Date, Time: ";
3570  LINPUT A$
3580  A$=UOS$(A$)
3590  IF A$[1,3]#"//S" THEN 3620
3600  GOSUB 1140
3610  GOTO 4960
3620  IF A$#"" THEN 3650
3630  GOSUB 1140
3640  GOTO 690
3650  IF A$[1,3]#"//H" THEN 3700
3660  PRINT " Enter the expiration date in the following format:  JJJ/YY,HHMM"
3670  PRINT " Where J is the julian date, Y is the year, H is the hour (In 24"
3680  PRINT " hour format), and M is the minute.  All leading zeros must be entered."
3690  GOTO 3560
3700  IF POS(A$,"/")>1 AND POS(A$,",")>4 AND POS(A$,",")#LEN(A$) THEN 3730
3710  PRINT "Illegal format"
3720  GOTO 3560
3730  IF POS(A$,"/")=POS(A$,",")-1 THEN 3710
3740  CONVERT A$[1,POS(A$,"/")-1] TO D,5679
3750  CONVERT A$[POS(A$,"/")+1,POS(A$,",")-1] TO Y,5679
3760  CONVERT A$[POS(A$,",")+1] TO H,5679
3770  IF ABS(D)=INT(D) AND D<367 AND ABS(Y)=INT(Y) AND Y<100 THEN 3800
3780  PRINT A$;": Meaningless figures"
3790  GOTO 3560
3800  IF H=-2 OR (ABS(H)=INT(H) AND H<2460) THEN 4160
3810  GOTO 3780
3820  PRINT "Type digits only"
3830  GOTO 3560
3840  REM ***** Calculate string input *****
3850  IF P>1 AND P#LEN(B$) THEN 3880
3860  PRINT "Illegal format"
3870  GOTO 690
3880  A$=B$[1,P-1]
3890  P1=P
3900  GOSUB 2470
3910  IF E THEN 690
3920  P=P1
3930  B$=B$[P+1]
3940  T=POS("ET",B$[1,1])
3950  IF T=0 THEN 3190
3960  P=POS(B$,",")
3970  IF P<2 OR P=LEN(B$) THEN 3210
3980  B$=B$[P+1]
3990  IF T=2 THEN 4140
4000  REM ***** Expiration type banner *****
4010  P=POS(B$,",")
4020  IF P>1 THEN 4050
4030  CONVERT B$ TO N,5121
4040  GOTO 4060
4050  CONVERT B$[1,P-1] TO N,5121
4060  IF ABS(N-1)#INT(N-1) THEN 3370
4070  IF P<2 OR P=LEN(B$) THEN 4100
4080  CONVERT B$[P+1] TO S,5954
4090  GOTO 4110
4100  S=0
4110  S=S*(S=-2)
4120  GOTO 4160
4130  REM ***** Time type banner *****
4140  A$=B$
4150  GOTO 3580
4160  REM ***** Get text of banner *****
4170  PRINT "Enter text, return alone to stop:";LIN(2)
4180  PRINT #1,1
4210  IF  END #1 THEN 4260
4220  PRINT ":";
4222  LINPUT I$
4230  IF I$="" THEN 4270
4240  PRINT #1;I$
4250  GOTO 4220
4260  PRINT '7"File full - Last line lost."
4270  IF REC(1)=1 THEN 4380
4280  ASSIGN *,2
4290  PURGE X,F$
4300  CREATE X,F$,REC(1)
4310  I$="MWA-"
4320  I$[5]=F$
4330  SYSTEM Z9,I$
4340  GOTO X+1 OF 4380,4380
4350  ASSIGN *,1
4360  PURGE Y,F1$
4370  GOTO X-1 OF 370,330,350
4380  ASSIGN F$,2,K
4390  PRINT #2;T
4400  IF T=2 THEN 4430
4410  PRINT #2;N,S
4420  GOTO 4440
4430  PRINT #2;D,Y,H
4440  READ #1,1
4450  IF  END #1 THEN 4490
4460  READ #1;I$
4470  PRINT #2;I$
4480  GOTO 4460
4490  REM ***** Set banner flag in flag file *****
4500  I$="LOG."
4510  I$[LEN(I$)+1]=A0$
4520  ASSIGN I$,3,R,"HAN"
4530  IF R=0 THEN 4570
4540  ASSIGN *,3
4550  PRINT '7"Flag file assign error - Banner not entered."
4555  SYSTEM X,"MES-"'7":::ASSIGN ERROR:::FLAG FILE:::BANNER:::"'7
4560  GOTO 4960
4570  IF  END #3 THEN 4940
4580  LOCK #3,R
4590  IF R=1 THEN 4580
4600  READ #3,100;E
4610  FOR X=1 TO E
4620  READ #3;I$
4630  IF I$[1,(POS(I$," ")-1) MIN 6]=F$[1,POS(F$,".")-1] THEN 4860
4640  NEXT X
4650  I$=F$[1,POS(F$,".")-1]
4660  FOR X=LEN(I$)+1 TO 25
4670  I$[X,X]=" "
4680  NEXT X
4690  I$[7,7]="B"
4700  READ #3,100;E
4710  FOR X=1 TO E
4720  READ #3;B$
4730  IF B$[1,1]=" " THEN 4800
4740  NEXT X
4750  PRINT #3;I$
4760  READ #3,100
4770  UPDATE #3;E+1
4780  ASSIGN *,3
4790  GOTO 4910
4800  READ #3,100
4810  ADVANCE #3;X,R
4820  UPDATE #3;I$
4830  UNLOCK #3
4840  ASSIGN *,3
4850  GOTO 4910
4860  I$[7,7]="B"
4870  READ #3,100
4880  ADVANCE #3;X,R
4890  UPDATE #3;I$
4900  ASSIGN *,3
4910  PRINT F$[1,POS(F$,".")-1];": Banner ready"
4920  ASSIGN *,2
4930  GOTO 690
4940  ASSIGN *,3
4950  PRINT '7"Flag file error - Data out of format - Banner not entered."'7
4960  REM ***** Stop the program *****
4970  ASSIGN *,1
4980  PURGE X,F1$
4990  END 
5000  REM ***** CHAIN TO $REPGEN *****
5005  PRINT LIN(1);"*** Repgen ***"
5010  CHAIN "$REPGEN"
5020  PRINT "Chain to $REPGEN failed"'7
5030  GOTO 690
5040  END 
