1 '	signon subsystem -- USER Maintanence
3 VERSION$="1.4 {10/14/82}"	'initial release was 1.01
5 '	by dick lieber
7 '
9 DEFDRIVE$="A:"
10 USERFILE$="USERS"
15 LASTCALRFILE$="LASTCALR"
20 PWDFILE$="pwds"
50 USER0%=0
67 BSTRING$=CHR$(8)+" "+CHR$(8)
68 CRLF$=CHR$(&HA)+CHR$(&HD)
70 DIM ACLARRAY%(5,11)
71 DIM FLAGS%(14)
72 DIM USERS%(600,2)
77 ON ERROR GOTO 1000
80 '
81 '	function definition
82 '
83 '	add deliminators to time or date
84 DEF FNADDSEP$(DS$,DELIM$)=

	LEFT$(DS$,2)+DELIM$+MID$(DS$,3,2)+DELIM$+RIGHT$(DS$,2)
85 '	remove date or time deliminators
86 DEF FNKILLSEP$(DS$)=LEFT$(DS$,2)+MID$(DS$,4,2)+RIGHT$(DS$,2)
88 '	on-off function
90 DIM ONOFF$(3)
91 ONOFF$(0)="Off": ONOFF$(2)=" save "
92 ONOFF$(1)="On": ONOFF$(3)="delete "
93 DEF FNONOFF$(ONOFF%)=ONOFF$(ONOFF%)
94 DEF FNLINES$(NLINES%)=STRING$(NLINES%,CRLF$)
95 DEF FNHOURS$(TIME)=STR$(INT(TIME/60))+":"+

	RIGHT$("00"+MID$(STR$(TIME-(INT(TIME/60)*60)),2),2)
199 GOTO 10000
200 %INCLUDE 200.SSB
300 '
302 '	set user number
304 '
306 USERMD=TESTADDRESS+9
312 CALL USERMD(SETUSERNUMBER%)
345 RETURN
400 %INCLUDE 400500.SSB
700 '
705 '	get string into ANSWER$ then CRLF
710 '
715 GOSUB 500: PRINT: RETURN
1000 '
1004 '	Error handler
1008 '1.2
1010 IF ERR=52 AND ERL=8147 THEN RESUME NEXT	'old .UBK not found (so what)
1011 IF ERR=53 THEN NOFILE%=1: RESUME NEXT
1012 A$="Error Trap":CR%=2: GOSUB 400
1020 PRINT "ERR = ";ERR, "ERL = ";ERL
1028 ON ERROR GOTO 0
1100 %INCLUDE 1100.SSB
1300 %INCLUDE 1300.SSB
1400 %INCLUDE 1400.SSB
1600 %INCLUDE 1600.SSB
2500 %INCLUDE 2500.SSB
3100 '
3105 '	clear screen
3110 '
3115 A$=CLEARSCR$:CR%=1:GOSUB 400: RETURN
3300 '
3305 '	make selection
3310 '
3315 MAX%=0:GOSUB 500
3320 IF ANSWER$="" THEN SELECTION%=0: RETURN
3325 SELECTION%=ASC(ANSWER$)-64
3327 IF SELECTION% < 0 THEN SELECTION%=0
3330 RETURN
4700 '
4705 '	pause 
4710 '
4715 PRINT:PRINT TAB(25);
4720 LINE INPUT "Press RETURN to continue."; A$
4725 RETURN
5000 '
5005 '	test that user is the SYSOP
5010 '
5015 OPEN "I", #1, DEFDRIVE$+LASTCALRFILE$
5020	INPUT #1, FRNAME$,LNAME$,ACLVL%
5025 CLOSE #1
5030 IF FRNAME$+LANME$ = "SYSOP" AND ACLVL% => 9 THEN ZRETURN%=1 

		ELSE ZRETURN%=0
5035 RETURN
5100 '
5104 '	Subsystem Manager - Main menu
5108 ' 1.1
5112 GOSUB 3100
5116 PRINT
5120 PRINT TAB(30);"USER Maintainer"
5124 PRINT TAB(30);"<version ";VERSION$;">"
5128 PRINT
5156 PRINT TAB(20);"a	Display the roster of users."
5160 PRINT TAB(20);"b	Sort USER file."
5164 PRINT TAB(20);"c	Remove deleted user's records."
5168 PRINT TAB(20);"d	View a USER archive file."
5182 PRINT: PRINT TAB(20);"q	Leave subsystem manager."
5183 PRINT TAB(20);"r	Go back to subsystem manager."
5184 PRINT:PRINT TAB(25);"Press the letter of your selection > ";
5188 GOSUB 3300	'selector
5192 RETURN
5300 '
5304 '	exit module
5308 '
5310 SETUSERNUMBER%=0:GOSUB 300
5316 END
6000 '
6002 '	sort USERFILE$ by frequency of use
6004 '1.3
6006 GOSUB 3100
6008 PRINT TAB(20);"Sort USER file."
6010 PRINT FNLINES$(4);

	TAB(10);"Least number of uses to keep (default is 3) > ";
6012 MAX=3: GOSUB 500
6014 IF NKEY%=0 THEN MINIUSES=3: PRINT MINIUSES ELSE MINIUSES=VAL(ANSWER$)
6016 PRINT:PRINT TAB(20);"Records with zero uses are saved unless 'deleted'."
6018 PRINT:PRINT

	TAB(7);"Number of newest users to keep (default is 10) > ";
6020 MAX%=3: GOSUB 500
6022 IF NKEY%=0 THEN KEEPLAST=10: PRINT KEEPLAST ELSE KEEPLAST=VAL(ANSWER$)
6024 GOSUB 1400 ' open users
6026 FIELD #1, 88 AS MSTRUSER$
6028 SEP$="-"
6030 GOSUB 8600	'open user archive
6032 NDX%=1
6034 FOR REC=2 TO NEXTUSER-1
6036	SETUSERNUMBER%=USERNUMBER%: GOSUB 300
6038	GET #1,REC
6040	GOSUB 1300
6042	IF (SIGCNT = 0 OR SIGCNT => MINIUSES OR REC > NEXTUSER-KEEPLAST)

		AND DELETED%=0

		THEN GOSUB 6100: KEEP%=2

		ELSE GOSUB 8400: KEEP%=3
6044 PRINT FNONOFF$(KEEP%); FRNAME$;" ";LNAME$
6046 NEXT REC
6048 PRINT "Users remaining:";NDX%
6049 PRINT:PRINT "Sorting..."
6050 FOR J%=1 TO NDX%-1
6052	FOR K%=J%+1 TO NDX%
6054		IF USERS%(J%,2) >= USERS%(K%,2) THEN GOTO 6062
6056		SWAP USERS%(J%,1), USERS%(K%,1)
6058		SWAP USERS%(J%,2), USERS%(K%,2)
6060		PRINT ".";
6062	NEXT K%
6064	PRINT ":"
6066 NEXT J%
6068 PRINT:PRINT "Sort finished"
6072 GOSUB 8200	'close archive
6074 GOSUB 8500	'open temp file
6075 PRINT:PRINT "Building new USERS file."
6076 FOR INDEX%=1 TO NDX%-1
6078	GET #1, USERS%(INDEX%,1)
6079	PRINT ".";
6080	GOSUB 8300	'put into temp
6082 NEXT INDEX%
6084 GOSUB 8100	'close temp, make USERFILE$
6086 RETURN
6100 '
6104 '	add record to sort array
6108 '
6112 USERS%(NDX%,1)=REC
6116 USERS%(NDX%,2)=SIGCNT
6120 NDX%=NDX%+1
6124 RETURN
6200 '
6210 '	display sort array
6220 '
6230 FOR INDEX%=1 TO NDX%
6240	PRINT USERS%(INDEX%,1),USERS%(INDEX%,2)
6250 NEXT INDEX%
6260 RETURN
7000 '
7004 '	view a USERFILE archive
7008 '1.1
7012 SETUSERNUMBER%=0: GOSUB 300
7016 GOSUB 3100
7020 PRINT FNLINES$(5);"These are the USER archives:"
7024 PRINT
7028 FILES MGRDRIVE$+"????????.USR"
7032 PRINT FNLINES$(3);TAB(20);"Type date of file to view > ";
7036 MAX%=8: GOSUB 500
7040 IF NKEY%=0 THEN RETURN
7044 VIEWFILE$=ANSWER$+".USR"
7048 SETUSERNUMBER%=0: GOSUB 300
7050 NOFILE%=0
7052 OPEN "I", #1, MGRDRIVE$+VIEWFILE$
7056 CLOSE #1
7060 IF NOFILE%<>0 THEN

	GOSUB 3100: PRINT FNLINES$(10); TAB(20); MGRDRIVE$+VIEWFILE$;

		" does not exist.":

	GOSUB 4700:

	GOTO 7000
7064 GOSUB 2500
7068 GOTO 7000
7100 '
7105 '	 back to POSYS
7110 '
7115 SETUSERNUMBER%=0: GOSUB 300
7120 JUMPFILE$="POSYS"
7125 GOSUB 7800
7130 RETURN
7800 %INCLUDE 7800.SSB
8000 '
8004 '	remove deleted records
8008 '1.3
8012 GOSUB 3100
8016 GOSUB 8500	'open temp USERS
8020 SEP$="/"
8024 GOSUB 8600	'open archive USERS
8028 GOSUB 1400	'open USERS
8032 FIELD #1, 88 AS MSTRUSER$
8036 FOR INDEX = 2 TO NEXTUSER-1
8040	GET #1, INDEX
8044	GOSUB 1300
8048	PRINT FNONOFF$(DELETED% + 2);FRNAME$;" ";LNAME$
8052	IF DELETED%=0 THEN

		GOSUB 8300 ELSE

		GOSUB 8400
8056 NEXT INDEX
8060 GOSUB 8100
8064 GOSUB 8200
8068 RETURN
8100 '
8104 '	close temp & change to new USERFILE$
8108 '1.1
8112 GOSUB 1600
8116 LSET TFUEXTUSER$=STR$(RECTEMP+1)	'NEXTuser
8120 LSET TFUSERSIG$="*"
8124 LSET TFUDATE$=DATE$
8128 LSET TFUTIME$=TIME$
8132 LSET TFUCRLF$=CRLF$
8136 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
8140 PUT #2,1
8144 CLOSE #1: CLOSE #2
8147 KILL DEFDRIVE$+USERFILE$+".UBK"
8148 NAME DEFDRIVE$+USERFILE$ AS DEFDRIVE$+USERFILE$+".UBK"
8152 NAME DEFDRIVE$+USERFILE$+".$$$" AS DEFDRIVE$+USERFILE$
8156 RETURN
8200 '
8204 '	close archive user
8208 '
8212 SETUSERNUMBER%=0: GOSUB 300
8216 LSET AFUEXTUSER$=STR$(RECARCH+1)
8220 LSET AFUSERSIG$="*"
8224 LSET AFUDATE$=DATE$
8228 LSET AFUTIME$=TIME$
8232 LSET AFUCRLF$=CRLF$
8236 PUT #3,1
8240 CLOSE #3
8244 RETURN
8300 '
8304 '	put into temp
8308 '
8312 LSET MSTRTEMP$=MSTRUSER$
8316 RECTEMP = RECTEMP+1
8320 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
8324 PUT #2, RECTEMP
8328 RETURN
8400 '
8404 '	put into archive
8408 '
8412 LSET MSTRARCH$=MSTRUSER$
8416 RECARCH = RECARCH+1
8420 SETUSERNUMBER%=0: GOSUB 300
8424 PUT #3, RECARCH
8428 RETURN
8500 '
8504 '	open work file of USERS
8508 '
8512 SETUSERNUMBER%=USERNUMBER%: GOSUB 300
8516 OPEN "R", #2, DEFDRIVE$+USERFILE$+".$$$", 88
8520 FIELD #2, 88 AS MSTRTEMP$
8524 FIELD #2,

	5 AS TFUEXTUSER$,

	1 AS TFUSERSIG$,

	6 AS TFUDATE$,	

	6 AS TFUTIME$,

	2 AS TFUCRLF$
8528 RECTEMP=1
8532 RETURN
8600 '
8604 '	open archive USERS
8608 '1.1
8612 SETUSERNUMBER%=0: GOSUB 300
8616 GOSUB 1600
8620 OPEN "R", #3, MGRDRIVE$+FNADDSEP$(DATE$,SEP$)+".USR", 88
8624 FIELD #3, 88 AS MSTRARCH$
8628 FIELD #3,

	5 AS AFUEXTUSER$,

	1 AS AFUSERSIG$,

	6 AS AFUDATE$,

	6 AS AFUTIME$,

	2 AS AFUCRLF$
8632 RECARCH=1
8636 RETURN
10000 '
10010 '	main program starts here
10020 ' 1.0
10025 GOSUB 1100
10030 IF SYSOPONLY%=1 THEN GOSUB 5000 ELSE ZRETURN%=1
10040 IF ZRETURN%=0 THEN PRINT "USRMAINT?": END
10055 IF NOFILE%<> 0 THEN PRINT "Bad start - See SIGNON.DOC": END
10060 GOSUB 5100
10066 IF SELECTION%=17 THEN GOTO 5300
10068 IF SELECTION%=18 THEN GOTO 7100
10070 ON SELECTION% GOSUB 2500, 6000, 8000, 7000
10080 GOTO 10060
20000 END