; HBBSMNT.Z80 v1					       17 Apr 88
;
; By Irv Hoff, based on Russ Pencin's PBBS, based on Simon Ewin's EMX.
;
;-----------------------------------------------------------------------
;
	ASEG			; Needed by M80 - else ignore any error
	.Z80
	ORG	0100H
;
	JP	START
;
VER:	DEFB	1		; Version
;
;
	INCLUDE	HBBSHDR.INC	; Options and header file
	INCLUDE	HBBSUBS.INC	; Subroutine file
;
; and A BYE REAL TIME CLOCK insert (needs to be in Z80 mnemonics).
;
	INCLUDE	BYERTC.INC	; Rename your BYE RTC insert to this
;				;   name and change the TIME: label to
;				;   TIMER:  The maintenance program will
;				;   now be able to get the current time
;				;   just like BYE gets it.  (Must be Z80
;				;   code, if not convert via XIZ.COM.)
;
;
;-----------------------------------------------------------------------
; You MUST have the next section just as it is here....
;-----------------------------------------------------------------------
;
RTCBUF:	DEFB	99H,99H,99H
	DEFB	19H,85H,02H,31H
CCHOUR:	DEFB	0
CCMIN:	DEFB	0
TIME:	DEFB	'HH:MM:SS',0	; <== place your ASCII time string here
DATE:	DEFB	'MM/DD/YY',0	; <== place your ASCII date string here
BDATE:	DEFS	3		; Binary date storage (filled in by GETTIM)
BTIME:	DEFS	3		; Binary time storage (filled in by GETTIM)
;
;-----------------------------------------------------------------------
; The values are returned from BYE as BCD and are converted below.
;-----------------------------------------------------------------------
;
GETRTC:	PUSH	DE
	PUSH	HL
	CALL	TIMER
	LD	HL,RTCBUF
	LD	DE,TIME
	CALL	BCD2A		; Convert hours digits
	INC	HL
	INC	DE		; Skip the colon
	CALL	BCD2A		; Convert minutes digits
	INC	HL
	INC	DE		; Skip colon
	CALL	BCD2A		; Convert seconds digits
	INC	HL
	INC	HL		; Skip century
	INC	HL		; Skip year
	INC	DE		; Skip the null between
	CALL	BCD2A		; Convert month digits
	INC	HL
	INC	DE		; Skip the slash
	CALL	BCD2A		; Convert day digits
	DEC	HL		; Skip month
	DEC	HL		; Point to year
	INC	DE		; Skip the slash
	CALL	BCD2A		; Convert year digits
	POP	HL
	POP	DE
	RET
;.....
;
BCD2A:	LD	A,(HL)
	PUSH	AF
	RRA			; Move high nibble to low
	RRA
	RRA
	RRA
	CALL	SPLAT		; Save it
	POP	AF		; Get BCD value back
;
SPLAT:	AND	0FH		; Only want lo nibble
	ADD	A,'0'		; Make ascii
	LD	(DE),A		; Place in string
	INC	DE		; Point to next byte in string
	RET			; Back to the city....
;.....
;
;	BCDBIN - convert BCD number to binary number
;	Entry:	 A = BCD number
;	Exit:	 A = binary number
;	Destroys: nothing
;
BCDBIN:	PUSH	DE
	LD	E,A		; Save original byte
	AND	15
	LD	D,A		; Save low nibble
	LD	A,E
	AND	240		; Mask LSN
	RRCA			; X2
	LD	E,A
	RRCA			; X4
	RRCA			; X8
	ADD	A,E		; X10
	ADD	A,D		; Low nibble
	POP	DE
	RET
;.....
;
;	BINBCD - convert binary number to BCD
;	Entry:	 A = binary number
;	Exit:	 A = BCD number
;	Destroys: nothing
;
BINBCD:	PUSH	DE
	LD	E,255		; -1
;
BLP:	INC	E		; Increment tens counter
	SUB	10		; Subtract 10 each pass
	JR	NC,BLP
	ADD	A,10		; Get back number
	LD	D,A
	LD	A,E
	RLCA			; Shift over to MSN
	RLCA
	RLCA
	RLCA
	ADD	A,D		; Add in ones position
	POP	DE
	RET
;.....
;
;-----------------------------------------------------------------------
;
; Start of program
;
START:	LD	HL,0		; Set up local stack
	ADD	HL,SP
	LD	(CCPSTK),HL	; Saving old one
	LD	SP,STACK
	CALL	ENDBBS		; Must call to get end of program in hl
	LD	A,0FFH
	LD	(HL),A		; Set flag for message area
	INC	HL
	LD	(MSG),HL	; Store msg pointer
	LD	DE,MSGBUF+128	; Size of message buffer must match that
				;   used in HBBS.Z80
	ADD	HL,DE		; Offset to array pointer
	XOR	A
	LD	(HL),A
	INC	HL
	LD	(MSGARR),HL	; Set msg array pointer
	LD	A,0C3H		; Patch error exit to avoid chain to bye
	LD	HL,EXIT
	LD	(ERROR),A	; Load error exit with jump to...
	LD	(ERROR+1),HL	; Address of soft return
	LD	A,0		; Insure hardlog off
	LD	(HRDLOG),A	; Let sysop turn it on
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'HBBS Maintenance v',0
	LD	A,(VER)		; Get the revision number
	LD	L,A
	LD	H,0
	CALL	PB2ASC
	CALL	IOPEN
	CALL	GET
	LD	HL,IDATEF
	LD	DE,IDATE
	LD	BC,NDXLEN
	LDIR			; Move index to memory
;
; Get today's date and place it in index area.	This resets the
; proper date if clock got screwed up.
;
MVDATE:	CALL	GETRTC
	CALL	CDATE
	CALL	CTIME		; Binary date & time set
	LD	IX,BDATE	; Point to binary date
	LD	IY,IDATE	; And date storage area
	LD	A,(IX)		; Get month
	LD	(IY),A		; Store it
	LD	A,(IX+1)	; Get day
	LD	(IY+1),A	; Store it
	LD	A,(IX+2)	; Get year
	LD	(IY+2),A	; Store it
;
; Menu selection
;
SYS1:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'        0: Quit',CR,LF
	DEFB	'        1: BYE hardlog on/off',CR,LF
	DEFB	'        2: Compress callers file',CR,LF
	DEFB	'        3: Maintain message file',CR,LF
	DEFB	'      * 4: Maintain USERS file',CR,LF
	DEFB	'        5: Maintenance hard-copy on/off',CR,LF
	DEFB	'        6: Pack message base',CR,LF
	DEFB	'        7: Read Sysop Log',CR,LF
	DEFB	'        8: Renumber messages',CR,LF
	DEFB	'        9: Update USERS file',CR,LF
	DEFB	0
;
SYSWT:	CALL	PRINT
	DEFB	CR,LF,'select:  ',BS,0 ; Clears last byte, just in case
	LD	C,RDCON		; Get character from console
	CALL	SPBDOS
	CP	'0'
	JR	C,SYSWT
	CP	'9'+1
	JR	NC,SYSWT
;
	CP	'1'
	JP	Z,BHLG
	CP	'2'
	JP	Z,PCALRS
	CP	'3'
	JP	Z,MMSG
	CP	'4'
	JP	Z,MUSR
	CP	'5'
	JP	Z,MHLG
	CP	'6'
	JP	Z,PACK
	CP	'7'
	JP	Z,SYSREAD
	CP	'8'
	JP	Z,RENUM
	CP	'9'
	JP	Z,RHASH
	CP	'0'
	JP	Z,EXIT
	JP	SYSWT
;.....
;
;-----------------------------------------------------------------------
;
EXIT:	CALL	PRINT
	DEFB	CR,LF,0
	LD	HL,(CCPSTK)
	LD	SP,HL
	RET			; Return to CCP stack
;.....
;
;-----------------------------------------------------------------------
;
RHASH:
;
; USER.BBS and MSGINDEX file cleanup.  Deletes any records that are over
; (DELLEV) days old. (DELLEV) is determined from a read of byte 4 of the
; access level table for current access level.	Banned users (access 1)
; are not deleted nor are any that have a 0 in byte 4 of their access
; level table.	(Usually this is access level 5 and greater.)
;
UPD25:	CALL	MOPEN		; Open file
	LD	HL,(IMNDX)	; Number records
	INC	HL
	LD	(RRNO),HL	; To record # counter
;
UPD25A:	LD	HL,(RRNO)
	DEC	HL
	LD	(RRNO),HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,UPD25B	; Yes
;
	CALL	GET
	LD	DE,TOALL	; Get start of array
	LD	HL,MTOF		; Point to name message is 'to'
	LD	B,4		; Length to match
	CALL	MATCH		; Is message to deleted user?
	OR	A
	JR	NZ,UPD25A	; Go again
	LD	A,(MREAD)	; See if message was deleted
	INC	A
	JR	Z,UPD25A	; If yes, exit, do not change
	LD	A,1
	LD	(MREAD),A	; Show msg "was read", for auto/delete
	LD	HL,(RRNO)
	CALL	PUT
	JR	UPD25A
;
UPD25B:	CALL	CLOSE		; Close the MSGINDEX.BBS file
	LD	IX,(MSGARR)	; Get pointer to array area
	PUSH	IX		; And save it
	XOR	A		; Mark end of current array
	LD	(IX),A
	LD	(IX+1),A	; With 2 nulls
	CALL	PRINT
	DEFB	CR,'(1 of 4) Updating USERS.BBS file',CR,LF
	DEFB	'Purging following names: ',CR,LF,0
	LD	HL,0
	LD	(IUSER),HL
	CALL	UOPEN		; Open the USERS.BBS file
	LD	HL,MAXU		; Number records
	LD	(RRNO),HL	; To record # counter
;
UPDA1:	LD	HL,(RRNO)	; Get current record
	DEC	HL		; One less to go
	LD	(RRNO),HL
	LD	A,H
	CP	0FFH		; See if we did record 0 yet
	JR	Z,UPDA2		; If yes, all done
;
	CALL	GET		; Get current user's data into memory
	LD	A,(LENGF)
	CP	72+1
	JP	C,CHECK
	LD	A,72
	LD	(LENGF),A
;
CHECK:	LD	HL,0FFH
	LD	(USRMPF),HL
	LD	(DRVMPF),HL
	LD	HL,CITSTF
	LD	DE,MTOTMP
	LD	BC,20
	LDIR
	LD	B,20
	LD	DE,MTOTMP
	LD	HL,CITSTF
;
CHECK1:	LD	A,(DE)
	CP	','
	JP	NZ,CHECK3
	INC	DE
	LD	A,(DE)
	CP	' '
	JP	Z,CHECK3
	OR	A
	JP	Z,CHECK4
	PUSH	AF
	LD	A,' '
	LD	(HL),A
	INC	HL
	POP	AF
;
CHECK3:	CP	'a'
	JP	C,CHECK4
	AND	5FH
;
CHECK4:	LD	(HL),A
	OR	A
	JP	Z,CHECK5
	INC	DE
	INC	HL
	DEC	B
	JP	NZ,CHECK1
;
CHECK5:	XOR	A
	LD	(UFACCF+1),A	; Zero the area access byte, it gets
	LD	HL,(RRNO)	;   properly changed each log-in
	CALL	PUT		; Store his data in the USERS.BBS file
	JR	UPDA1		; Keep going until done
;...
;
UPDA2:	LD	HL,MAXU		; Number records
	LD	(RRNO),HL	; To record # counter
;
SRTLP:	LD	HL,(RRNO)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JP	Z,UPD252	; Yes
	CALL	GET
	XOR	A		; Clear carry flag
	LD	A,(ACESSF)
	SUB	2		; Set base
	JR	C,SRTLP
	LD	DE,ACTBLEN	; Length of each entry in table
	LD	H,0
	LD	L,A		; HL=access level
	CALL	MLDL		; HL=offset
	LD	DE,ACC2+3	; Start of table + offset to byte wanted
	ADD	HL,DE		; HL=address for this access level
;
; HL --> days inactivity is tolerated
;
	LD	A,(HL)
	LD	(DELLEV),A	; A=days to deletion
	LD	IY,BDATE	; Today's date
	LD	IX,LSTONF	; Last time this record active
	CALL	DATDIF		; Compare dates
	LD	A,H		; Check that the clock is not screwy
	OR	A
	JP	M,CLKERR	; Bad news...don't touch a thing
	LD	A,(DELLEV)	; Get # days to deleteion
	OR	A		; 0=no delete
	JR	Z,ADDONE	; Don't delete this guy, but bump count
	LD	D,0
	LD	E,A		; Days tolerated to de
	AND	A		; Clear carry
	SBC	HL,DE		; Hl(inactivity) > de(tolerated)?
	JR	Z,ADDONE	; Equal so...
	JR	C,ADDONE	; Okay so don't delete
	LD	HL,UNAMEF
	CALL	PRINTN
	CALL	PRINT
	DEFB	CR,LF,0
	LD	HL,UNAMEF	; Move user name to array
	POP	DE		; Get current array pointer
	LD	BC,NAMLEN	; Length to move
	LDIR			; Name now added to message delete list
	PUSH	DE		; And save it (now updated)
;
NOM:	XOR	A
	LD	(ACESSF),A	; Delete user
	LD	(MAILF),A	; And his mail flag
	LD	HL,(RRNO)
	CALL	PUT
	JP	SRTLP
;.....
;
ADDONE:	LD	HL,(IUSER)	; Insure user number is current
	INC	HL		; This was a valid user so bump the count
	LD	(IUSER),HL	; And store it back
	JP	SRTLP		; Get the next one
;.....
;
UPD252:	CALL	CLOSE		; USERS.BBS
	POP	IX		; Get back end of array (if existing)
	XOR	A		; And null 2 bytes to mark end
	LD	(IX),A
	LD	(IX+1),A
	LD	IX,(MSGARR)	; See if we have any mail to delete
	LD	A,(IX)
	LD	B,(IX+1)
	OR	B		; If first 2 bytes are 0 then none
	JR	Z,UPD254	; None, so quit
	CALL	MOPEN		; MSGINDEX.BBS
	LD	HL,(IMNDX)	; Number records
	INC	HL
	LD	(RRNO),HL	; To record # counter
;
SRTLP2:	LD	HL,(RRNO)
	DEC	HL
	LD	A,H
	CP	0FFH		; Done with records?
	JR	Z,UPD253	; Yes
	CALL	GET
	LD	DE,(MSGARR)	; Get start of array
	PUSH	DE		; Save it
;
; Kill messges to any purged user
;
DELOP:	LD	HL,MTOF		; Point to name message is 'to'
	LD	B,NAMLEN	; Length to match
	CALL	MATCH		; Is message to deleted user?
	OR	A
	JR	Z,DELOP1	; Yes, so kill it
;
; Check next name
;
	POP	DE		; No so...
	LD	HL,NAMLEN	; Point to next name in array
	ADD	HL,DE
	EX	DE,HL		; Pointer in DE
	PUSH	DE
	POP	IX
	LD	A,(IX)
	LD	B,(IX+1)
	OR	B
	JR	Z,SRTLP2	; No more names, check if more messages
	PUSH	DE		; Save new pntr, see if deletion needed
	JR	DELOP
;
DELOP1:	POP	DE		; Unjunk stack
	LD	A,1		; Show msg "was read", for auto-delete
	LD	(MREAD),HL	; Delete message
	LD	HL,(RRNO)
	CALL	PUT
	JR	SRTLP2
;.....
;
UPD253:	CALL	CLOSE		; MSGINDEX.BBS
;
UPD254:	LD	HL,BDATE
	LD	DE,MUSRD
	LD	BC,3
	LDIR
	LD	HL,BTIME
	LD	DE,MUSRT
	LD	BC,3
	LDIR
	LD	HL,IDATE	; Move from buffer
	LD	DE,IDATEF	; To storage
	LD	BC,NDXLEN	; This many bytes
	LDIR			; Move record
	CALL	IOPEN		; INDEX.BBS
	CALL	PUT
	CALL	CLOSE		; INDEX.BBS
	CALL	PRINT
	DEFB	CR,LF,'Done',CR,LF,0
	JP	HASH1
;.....
;
CLKERR:	POP	IY		; Clear the stack
	CALL	CLOSE		; Close any open files
	CALL	PRINT
	DEFB	'Date error...No update performed',CR,LF
	DEFB	'The following user has an invalid Date: ',0
	LD	HL,UNAMEF
	LD	B,NAMLEN
	CALL	PRINTN
;
HASH1:	LD	HL,USERS2	; "USERS.BAK"
	CALL	BFCB
	LD	DE,FCB		; Kill USERS.BAK if there
	CALL	KILBDOS
	LD	DE,RENU1
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
	CALL	RHSH2
	CALL	PRINT
	DEFB	'Writing new index...',0
	LD	HL,IDATE
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR
	CALL	IOPEN
	CALL	PUT		; Update index
	CALL	CLOSE
	JP	Z,SYS1		; If not, return to menu
	CALL	PRINT
	DEFB	'Done',CR,LF,0
	JP	SYS1		; Finished
;.....
;
RHSH2:	LD	HL,0
	LD	(UCOUNT),HL	; Zero the user counter
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'(2 of 4) Initializing new user file...',0
	LD	HL,RNDBUF	; First fill random buffer with nulls
	LD	A,0
	LD	B,USRLEN
;
HFILL:	LD	(HL),A
	INC	HL
	DJNZ	HFILL
	LD	HL,USRWRK	; USERS.BBS
	CALL	OPEN2
	LD	HL,USRLEN
	LD	(RRSZ2),HL
	LD	HL,MAXU		; Start at last record
	LD	(RRNO2),HL
;
HWRT:	CALL	PUT2		; Null out the record
;
HBMP:	LD	HL,(RRNO2)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	NZ,HWRT		; Yes
;
	CALL	PRINT
	DEFB	'Done',CR,LF,CR,LF
	DEFB	'(3 of 4) Reading record:',CR,LF,CR,LF,0
	LD	HL,USERS2	; USERS.BAK
	CALL	OPEN
	LD	HL,USRLEN
	LD	(RRSZ),HL
	LD	HL,0		; Start at first record
	LD	(NREC1),HL	; Initialize counter for number of users
	LD	DE,(MSGARR)	; Get start of array space
	PUSH	DE		; Save pointer for later
;
RDLOOP:	PUSH	HL
	CALL	PRINT
	DEFB	CR,0
	POP	HL
	PUSH	HL
	INC	HL
	CALL	PB2ASC
	CALL	PRINT
	DEFB	' ',0
	POP	HL
	CALL	GET
	LD	A,(ACESSF)	; See if its a deleted or free record
	OR	A
	JR	NZ,LASNAM	; Nope, it's active
	LD	HL,(RRNO)
	INC	HL		; Oh well, go see if there are any more
	EX	DE,HL
	LD	HL,MAXU
	XOR	A		; Clear carry
	SBC	HL,DE		; Any left?
	EX	DE,HL
	JR	NZ,RDLOOP	; Yup, go get 'em
	JP	RHSH3		; Else, go and get ready to sort array
;...
;
LASNAM:	LD	HL,UNAMEF	; Point to user's name
;
LNAM1:	LD	A,(HL)		; Get character from name
	CP	' '		; Space?
	INC	HL		; Point to next char anyway
	JR	NZ,LNAM1	; Nope, carry on
	POP	DE		; Restore array pointer
	LD	BC,8		; 8 chars should be enough
	LDIR			; Move last name into array
	LD	BC,(NREC1)	; Get user counter
	INC	BC		; Add one
	LD	(NREC1),BC	; Put it back
	LD	HL,(RRNO)	; Get record number
	EX	DE,HL
	LD	(HL),E		; Put it
	INC	HL		; Into
	LD	(HL),D		; Array
	INC	HL
	EX	DE,HL		; Restore pointers
	PUSH	DE		; Save array pointer
	LD	HL,(RRNO)	; Get record number
	INC	HL		; Point to next record
	EX	DE,HL
	LD	HL,MAXU		; At end?
	XOR	A		; Clear carry
	SBC	HL,DE
	EX	DE,HL
	JP	NZ,RDLOOP	; Nope...go around
;
RHSH3:	POP	HL		; Get end of array
	DEC	HL		; Adjust so it points
	DEC	HL		; To last record number
	LD	(ENDARR),HL	; Save it for later
	LD	HL,(MSGARR)	; Get start of array
	LD	(STARR),HL	; Also save it
	LD	HL,(NREC1)	; Get number of records
	LD	(NREC2),HL	; Put it here too
	CALL	PRINT
	DEFB	CR,LF,CR,LF,'Sorting users by last name...',0
	CALL	SMSORT		; Sort users alphabetically, by last name
	CALL	PRINT
	DEFB	'Done'
	DEFB	CR,LF,CR,LF,0
	LD	HL,(MSGARR)	; Get start of array again
	LD	DE,8		; Calculate loc'n of
	ADD	HL,DE		; First record
	LD	(STARR),HL	; Save it for later
	PUSH	HL		; Also put into
	POP	IX		; IX register
	LD	A,(HL)		; Get number
	INC	HL		; Of first
	LD	H,(HL)		; Record
	LD	L,A		; Into HL
	LD	(RRNO),HL	; Save first record number
	CALL	PRINT
	DEFB	'(4 of 4) Processing record:',CR,LF,CR,LF,0
;
READLP:	CALL	PRINT
	DEFB	CR,0
	LD	HL,(RRNO)	; Get next record number
	PUSH	HL		; Save it for later
	CALL	PB2ASC		; Display for all to see
	CALL	PRINT
	DEFB	'  ',0
	POP	HL		; Now restore record number
	CALL	GET		; And get the appropriate record
	LD	HL,RNDBUF	; Move user info
	LD	DE,AVAIL	; From buffer
	LD	BC,USRLEN	; To memory
	LDIR
	LD	A,(IX-8)	; Get first char of last name (from array)
	CALL	HASH		; Calc starting pos'n in USERS.PBS
	LD	(HSHREC),HL
;
HLOOP:	CALL	GET2		; Get record from the new file
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,ADDREC	; If not active, go add this user
	LD	HL,(RRNO2)	; Else, already used, try next record
	INC	HL
	JR	NZ,HLOOP
	LD	HL,MAXU		; Load up last record in file
	DEC	HL
	JR	HLOOP		; And keep going
;
ADDREC:	LD	HL,(UCOUNT)	; New users count
	INC	HL		; Bump it
	LD	(UCOUNT),HL
	LD	HL,AVAIL	; Get user info
	LD	DE,AVAILF	; From memory to
	LD	BC,USRLEN	; Random buffer
	LDIR
	LD	HL,(RRNO2)	; Put it into new
	CALL	PUT2		; File at correct spot
	LD	HL,(STARR)	; Get array pointer
	EX	DE,HL
	LD	HL,(ENDARR)	; Get end of array
	XOR	A		; Clear carry
	SBC	HL,DE
	EX	DE,HL
	JR	Z,LODDON	; Yup...wrap it up
	LD	DE,10		; Calc loc'n of
	ADD	HL,DE		; Next record number
	LD	(STARR),HL	; Save pointer again
	PUSH	HL		; And put it
	POP	IX		; Into IX register
	LD	A,(HL)		; Get number
	INC	HL		; Of next
	LD	H,(HL)		; Record
	LD	L,A		; Into HL
	LD	(RRNO),HL	; Save next record number
	JP	READLP		; And go around again
;.....
;
LODDON:	CALL	CLOSE
	CALL	CLOSE2
;
	 IF	NOT SAVBAK
	LD	HL,USERS2	; USERS.BAK
	CALL	BFCB		; Move name to FCB area
	LD	DE,FCB		; Then kill that file, if present
	CALL	KILBDOS
	 ENDIF			; NOT SAVBAK
;
	CALL	PRINT
	DEFB	CR,0
	LD	HL,MAXU		; Load up last record in file
	CALL	PB2ASC		; Display for all to see
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Update completed...updating user count...',0
	CALL	GETRTC
	CALL	CDATE
	CALL	CTIME		; Binary date & time set
	LD	HL,BTIME
	LD	DE,MUSRT
	LD	BC,3
	LDIR			; Set time
	LD	HL,BDATE
	LD	DE,MUSRD
	LD	BC,3
	LDIR			; Set date
	LD	HL,(UCOUNT)	; Set number of users
	LD	(IUSER),HL
	CALL	PRINT
	DEFB	'Done',CR,LF,CR,LF,0
	RET
;.....
;
MUSR:	CALL	@PRNT
	DEFB	CR,LF,CR,LF
	DEFB	'User file last maintained:  ',0
	LD	IX,MUSRT	; Point at user mnt time
	CALL	PTIME
	CALL	@PRNT
	DEFB	' on ',0
	LD	IX,MUSRD	; Point to user maintenance date
	CALL	PDATE
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'CAUTION:  Take note of old data BEFORE changing....',0
;
MUASK:	LD	A,0
	LD	(TRECNO),A	; Set starting record
	LD	A,0FFH
	LD	(DLEVEL),A	; Set level to all
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter level to display, <ret> for ALL:  ',0
;
MUASK1:	CALL	GETCH
	CP	'C'-40H
	JP	Z,SYS1
	CP	'K'-40H
	JP	Z,SYS1
	CP	'X'-40H
	JP	Z,SYS1
	CP	CR
	JP	Z,MUCON		; <ret> escapes, displays all levels
	CP	'0'
	JR	C,MUASK1
	CP	'9'+1
	JR	NC,MUASK1
	CALL	ECHO		; Display the character
	SUB	'0'		; Make it binary
	LD	(DLEVEL),A	; Set display level
	JR	MUCON1
;
MUCON:	CALL	PRINT
	DEFB	'All levels',0
;
MUCON1:	CALL	PRINT
	DEFB	CR,LF,0
	CALL	UOPEN
	LD	HL,0		; Start at beginning
;
UPLP:	PUSH	HL
	LD	C,DIRCON	; Direct keyboard call
	LD	E,0FFH
	CALL	SPBDOS		; Any ^C aborts
	CP	'C'-40H
	JR	NZ,UPLPA
	CALL	PRINT
	DEFB	CR,LF,'Emergency Abort..',0
	POP	HL
	JP	MUSR
;...
;
UPLPA:	POP	HL
	CALL	GET
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	NZ,UPLP0	; An active record, check it out
;
PBNXT:	LD	HL,(RRNO)
	INC	HL
	EX	DE,HL
	LD	HL,MAXU
	XOR	A		; Clear carry
	SBC	HL,DE
	EX	DE,HL
	JR	NC,UPLP
;
	LD	HL,0		; Load up last record in file
	LD	A,(TRECNO)
	OR	A
	JP	Z,PBEND		; We looked at all of them now
	XOR	A
	LD	(TRECNO),A
	JR	UPLP		; No, keep going
;...
;
PBEND:	CALL	PRINT
	DEFB	CR,LF,CR,LF,'No users found...',CR,LF,0
	JP	MUSR
;
UPLP0:	LD	A,(DLEVEL)	; Display level
	CP	0FFH
	JR	Z,UPLP1		; Display all of them
	LD	HL,DLEVEL
	LD	A,(ACESSF)	; Get user level
	CP	(HL)
	JR	NZ,PBNXT	; Get the next one
;
UPLP1:	CALL	@PRNT
	DEFB	CR,LF,CR,LF
	DEFB	'0:  Record number........... ',0
	LD	HL,(RRNO)
	LD	A,1
	LD	(TRECNO),A
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'1:  Name.................... ',0
	LD	HL,UNAMEF
	LD	B,NAMLEN
	CALL	@PRNTL
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'2:  From.................... ',0
	LD	HL,CITSTF
	LD	B,20
	CALL	@PRNTL
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'3:  Password................ ',0
	LD	HL,PSWRDF
	LD	B,10
	CALL	@PRNTL
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'P:  Phone .................. ',0
	LD	HL,PHONEF
	LD	B,12
	CALL	@PRNTL
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'4:  Access.................. ',0
	LD	H,0
	LD	A,(ACESSF)
	LD	(ACCTMP),A	; Save temporarily
	LD	L,A
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'5:  Signons................. ',0
	LD	HL,(TMSONF)
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'6:  Last on................. ',0
	LD	IX,LSTONF
	CALL	PDATE
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'7:  Initial du.............. ',0
	LD	A,(INTARF)
	PUSH	AF
	AND	00001111B	; Get drive
	ADD	A,41H		; Make letter
	CALL	@ECHO		; Print drive
	POP	AF
	AND	11110000B	; Get user area
	RRCA
	RRCA
	RRCA
	RRCA			; Move to low 4 bits
	LD	L,A
	LD	H,0
	CALL	PB2ASC		; Show user area
	LD	A,':'
	CALL	@ECHO
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'8:  MSGs waiting............ ',0
	LD	A,(MAILF)
	LD	L,A
	LD	H,0
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'9:  Number of nulls......... ',0
	LD	A,(NNULLF)
	LD	L,A
	LD	H,0
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'A:  Last baudrate code...... ',0
	LD	A,(BDCDEF)
	LD	L,A
	LD	H,0
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'B:  number of uploads....... ',0
	LD	HL,(UPLDSF)
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'C:  number of downloads..... ',0
	LD	HL,(DNLDSF)
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'D:  Userarea map............ ',0
	LD	HL,(USRMPF)
	CALL	PMAP
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'E:  Drive map............... ',0
	LD	HL,(DRVMPF)
	CALL	PMAP
;
	 IF	TCAP
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'F:  Terminal identity code.. ',0
	LD	A,(TCODEF)
	LD	L,A
	LD	H,0
	CALL	PB2ASC
	 ENDIF			; TCAP
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'G:  Time on system.......... ',0
	LD	A,(TOTMEF)
	LD	L,A
	LD	H,0
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'H:  High message............ ',0
	LD	HL,(HIMSGF)
	CALL	PB2ASC
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'I:  Screen width............ ',0
	LD	HL,(LENGF)
	CALL	PB2ASC
;
	 IF	NMAREAS	GT 1
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'    Area number:   2'
;
	 IF	NMAREAS	GT 2
	DEFB	'   3'
	 ENDIF			; NMAREAS GT 2
;
	 IF	NMAREAS	GT 3
	DEFB	'   4'
	 ENDIF			; NMAREAS GT 3
;
	 IF	NMAREAS	GT 4
	DEFB	'   5'
	 ENDIF			; NMAREAS GT 4
;
	 IF	NMAREAS	GT 5
	DEFB	'   6'
	 ENDIF			; NMAREAS GT 5
;
	 IF	NMAREAS	GT 6
	DEFB	'   7'
	 ENDIF			; NMAREAS GT 6
;
	 IF	NMAREAS	GT 7
	DEFB	'   8'
	 ENDIF			; NMAREAS GT 7
;
	 IF	NMAREAS	GT 8
	DEFB	'   9 '
	 ENDIF			; NMAREAS GT 8
;
	DEFB	CR,LF
	DEFB	'J:  Area access:',0
	CALL	DACC		; Display access codes for areas 2-9
	 ENDIF			; NMAREAS GT 1
;
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'--> (n:) to alter, + for next, - for previous, '
	DEFB	'> to find/add, < to exit',0
;
UWT:	CALL	PRINT
	DEFB	CR,LF,'--> Select: ',0
	LD	C,RDCON		; Get a character from keyboard
	CALL	SPBDOS
	AND	7FH		; Strip off any parity
	CP	CR		; Go to the next selection
	JP	Z,BACKU
	CP	'-'
	JP	Z,MBPREC	; Move to next record
	CP	'<'
	JP	Z,MUDON		; Quit to main menu
	CP	'+'
	JP	Z,BACKU		; Move to previous record
	CP	'>'
	JP	Z,GOTO		; Set record to start and find user
	CP	'1'
	JP	Z,UWT3		; Change user's name
	CP	'2'
	JP	Z,UWT4		; Change city, province/state
	CP	'3'
	JP	Z,UWT2		; Change password
	CP	'4'
	JP	Z,UWT1		; Change access level
	CP	'5'
	JP	Z,TMO		; Change # times on
	CP	'6'
	JP	Z,LSTO		; Change last date on
	CP	'7'
	JP	Z,IDU		; Change initial drive/user
	CP	'8'
	JP	Z,MWF		; Change mail waiting flag
	CP	'9'
	JP	Z,NLS		; Change number of nulls
	AND	5FH		; Change to upper-case
	CP	'A'
	JP	Z,LBD		; Change last baud-rate
	CP	'B'
	JP	Z,UPL		; Change # uploads
	CP	'C'
	JP	Z,DNL		; Change downloads
	CP	'D'
	JP	Z,UMP		; Change user map
	CP	'E'
	JP	Z,DMP		; Change drive map
;
	 IF	TCAP
	CP	'F'
	JP	Z,TCD		; Change terminal code
	 ENDIF			; TCAP
;
	CP	'G'
	JP	Z,TCH		; Change Time on system
	CP	'H'
	JP	Z,HCH		; Change high message read
	CP	'I'
	JP	Z,TCW		; Change terminal line length
;
	 IF	NMAREAS	GT 1
	CP	'J'
	JP	Z,ICH		; Change a area access
	 ENDIF			; NMAREAS GT 1
;
	CP	'P'
	JP	Z,PHN		; Change the phone #
	JP	UWT
;.....
;
PMAP:	PUSH	HL		; Save for later
	LD	C,H
	CALL	P8BITS		; Do msb (bit 16=user 15)
	POP	HL
	LD	C,L
	CALL	P8BITS		; And lsb (bit 0=user 0)
	RET
;.....
;
P8BITS:	LD	B,8		; Set counter
;
P8B1:	LD	A,'0'
	BIT	7,C		; Test
	JR	Z,P8B2
	INC	A		; Make ASCII '1'
;
P8B2:	CALL	@ECHO
	SLA	C		; Move next bit into place
	DJNZ	P8B1		; Keep going
	RET			; Done if 0
;.....
;
CMAP:	CALL	C8BITS
	PUSH	AF		; Save result (for H later)
	CALL	C8BITS
	LD	L,A
	POP	AF
	LD	H,A
	RET			; HL=binary
;.....
;
C8BITS:	LD	B,8
	LD	C,0
;
C8B1:	SLA	C
	LD	A,(HL)		; Get character
	INC	HL
	SUB	30H
	OR	C		; Merge results
	LD	C,A		; Save result in c
	DJNZ	C8B1		; Not done
	RET
;.....
;
UMP:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'- userarea map (hex) --> FEDCBA9876543210'
	DEFB	CR,LF
	DEFB	'Enter map for userareas: ',0
	LD	A,0
	LD	D,A
	LD	C,A
	LD	B,16
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	CALL	CMAP		; Convert ascii (bin) to binary in hl
	LD	(USRMPF),HL	; Save it
	JP	UWRT
;.....
;
DMP:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'- drive map --------> PONMLKJIHGFEDCBA'
	DEFB	CR,LF
	DEFB	'Enter map for drives: ',0
	LD	A,0
	LD	D,A
	LD	C,A
	LD	B,16
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	CALL	CMAP
	LD	(DRVMPF),HL
	JP	UWRT
;.....
;
NLS:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter number of nulls (0-50): ',0
	LD	B,2
	LD	A,0
	LD	D,0
	LD	C,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX		; Pointer to string in ix
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	PUSH	HL		; Save result
	LD	DE,51
	AND	A
	SBC	HL,DE
	POP	HL		; Recover result in case okay
	JR	NC,NLS		; 255 max
	LD	A,L
	LD	(NNULLF),A
	JP	UWRT
;.....
;
LBD:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter baud-code (0-9): ',0
;
LBDWT:	CALL	GETCH
	CP	CR
	JP	Z,UPLP0		; <ret> escapes
	CP	'0'
	JR	C,LBDWT
	CP	'9'+1
	JR	NC,LBDWT
	CALL	ECHO
	SUB	30H		; Make it binary
	LD	(BDCDEF),A
	JP	UWRT
;.....
;
UPL:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter number of uploads: ',0
	LD	B,5
	LD	A,0
	LD	D,0
	LD	C,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX		; Pointer to string in ix
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	LD	(UPLDSF),HL
	JP	UWRT
;.....
;
DNL:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter number of downloads: ',0
	LD	B,5
	LD	A,0
	LD	D,0
	LD	C,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX		; Pointer to string in ix
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	LD	(DNLDSF),HL
	JP	UWRT
;.....
;
TCD	EQU	$
;
	 IF	TCAP
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter terminal code (0-255): ',0
	LD	B,3
	LD	A,0
	LD	D,0
	LD	C,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX		; Pointer to string in ix
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	PUSH	HL		; Save result
	LD	DE,256
	AND	A
	SBC	HL,DE
	POP	HL		; In case okay, recover result
	JR	NC,TCD		; 255 max
	LD	A,L
	LD	(TCODEF),A	; Store it
	JP	UWRT
	 ENDIF			; TCAP
;.....
;
TCW:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter screen width (10-7'
;
	 IF	LINNOS
	DEFB	'4'
	 ENDIF			; LINNOS
;
	 IF	NOT LINNOS
	DEFB	'8'
	 ENDIF			; NOT LINNOS
;
	DEFB	'): ',0
	LD	B,2
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number characters to convert
	PUSH	HL
	POP	IX		; Pointer to ix
	CALL	CNVRT0		; Make string binary number
	LD	A,L		; Get the converted value
	CP	10		; Insist on at least 10 columns
	JR	NC,TCW1
	LD	A,10
;
TCW1	EQU	$
;
	 IF	LINNOS
	CP	74+1		; See if less than maximum
	JR	C,TCW2		; If yes, handle normally;
	LD	A,74		; Maximum CRT width (and buffer size)
	 ENDIF			; LINNOS
;
	 IF	NOT LINNOS
	CP	78+1		; See if less than maximum
	JR	C,TCW2		; If yes, handle normally;
	LD	A,78		; Maximum CRT width (and buffer size)
	 ENDIF			; NOT LINNOS
;
TCW2:	LD	(LENGF),A
	JP	UWRT
;.....
;
TCH:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter time on system: ',0
	LD	B,5
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX		; Pointer to string in ix
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	LD	A,L
	LD	(TOTMEF),A
	JP	UWRT
;.....
;
HCH:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter highest msg read: ',0
	LD	B,5
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX		; Pointer to string in ix
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	LD	(HIMSGF),HL
	JP	UWRT
;.....
;
;-----------------------------------------------------------------------
;
	 IF	(NMAREAS GT 1)
ICH:	CALL	DAREA
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter the area number, <ret> to EXIT: ',0
;
ICH1:	CALL	GETCH
	CALL	CAPS
	CP	CR
	JP	Z,UPLP0
	CP	'2'
	JR	C,ICH1
	CP	030H+(NMAREAS+1)
	JR	NC,ICH1
	CALL	ECHO
	SUB	030H
	LD	(SAREA),A
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter Y to access, N for no access, B to block, '
	DEFB	'<ret> to Exit: ',0
;
ICH2:	CALL	GETCH
	CP	CR
	JP	Z,UPLP0
	CALL	CAPS
	CP	'B'
	JR	Z,ICH3
	CP	'Y'
	JR	Z,ICH3
	CP	'N'
	JR	NZ,ICH2
;
ICH3:	CALL	ECHO
	LD	(ICHI),A
;
; The following code will set and reset the proper bits in the user's
; record for the area access change options input above.  This code
; uses the Z80 BIT set and reset functions.  In order to save code and
; eliminate a loop to test which bit to be set/reset the code is set
; to be self-modifying.  The basic structure is to add a series of
; constant values to the basic SET 0,B code to create a SET x,B;
; SET x,C; RES x,B; and RES x,C instruction bases on the bit (area)
; selected above (and saved in (SAREA)).  DO NOT CHANGE THIS CODE or
; YOU MAY HAVE A DISASTER on your HANDS.
;
ICH4:	LD	A,(UFACCF)
	LD	B,A
	LD	A,(UFACCF+1)
	LD	C,A
	LD	A,(SAREA)
	SUB	2
	ADD	A,A
	ADD	A,A
	ADD	A,A
	LD	D,A
	LD	A,080H		; Res 0,B
	ADD	A,D		; Res x,B
	LD	(ICH6+1),A
	LD	(ICH7+1),A
	INC	A		; Res x,C
	LD	(ICH5+3),A
	LD	(ICH6+3),A
	ADD	A,03FH		; Set x,B
	LD	(ICH5+1),A
	INC	A		; Set x,C
	LD	(ICH7+3),A
	LD	A,(ICHI)
	CP	'B'		; If 'B' to block
	JR	Z,ICH5
	CP	'N'		; If 'N' for no access
	JR	Z,ICH6
	JR	ICH7		; If 'Y' for yes for access
;
ICH5	EQU	$
;
	SET	0,B
	RES	0,C
	JR	ICH8
;
ICH6	EQU	$
;
	RES	0,B
	RES	0,C
	JR	ICH8
;
ICH7	EQU	$
;
	RES	0,B
	SET	0,C
;
ICH8:	LD	A,B
	LD	(UFACCF),A
	LD	A,C
	LD	(UFACCF+1),A
	JP	UWRT
;.....
;
ICHI:	DEFB	0		; Temp storage for 'G','R', or 'B' input
	 ENDIF			; NMAREAS GT 1
;.....
;
;-----------------------------------------------------------------------
;
GEND:	LD	HL,MAXU		; Get start of search
	DEC	HL
;
GEND1:	CALL	GET		; Get record
	LD	A,(AVAILF)	; See if active
	CP	0
	JP	Z,GEND2
	LD	A,(DLEVEL)
	CP	0FFH
	LD	HL,(RRNO)
	JP	Z,UPLP
	LD	HL,DLEVEL
	LD	A,(ACESSF)	; Get user level
	CP	(HL)
	JR	NZ,GEND2	; Get the next one
	LD	HL,(RRNO)
	JP	UPLP		; Get him to the first active record
;.....
;
GEND2:	LD	HL,(RRNO)
	DEC	HL
	JR	GEND1
;...
;
GSTRT:	LD	HL,0		; Get end of search (end of file)
	JP	UPLP
;.....
;
STARTM:	DEFB	'START',0
;
ENDM:	DEFB	'END',0
;
GOTO:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter first and last names (or START or END): ',0
	LD	B,NAMLEN-1
	LD	C,20H
	LD	A,0
	LD	D,0
	CALL	INPUT
	OR	A
	JP	Z,MBPREC
	LD	(LINES),A	; Save the length
	LD	DE,STARTM	; See if 'start'
	LD	HL,INBUF
	LD	B,6
	CALL	MATCH
	JP	Z,GSTRT
	LD	DE,ENDM
	LD	HL,INBUF
	LD	B,4
	CALL	MATCH
	OR	A
	JP	Z,GEND
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Searching...',0
	LD	HL,INBUF
;
PMHSH:	LD	A,(HL)		; Get a character
	INC	HL		; Next character
	OR	A		; See if it's a null (error)
	JP	Z,LREQD		; Go back and get a real name
	CP	' '		; See if it's a space
	JR	NZ,PMHSH
	LD	A,(HL)		; Get first char of last name
	CP	'A'		; Check for valid char.
	JP	C,LREQD		; Go get a real name
	CP	'Z'+1
	JP	NC,LREQD	; Go get A real name
	CALL	HASH		; Go cal stating position in USERS.BBS
;
PMDONE:	LD	(HSHREC),HL
	LD	(TRECNO),HL	; Leave him close to the record he wants
	LD	HL,(HSHREC)
;
GLOOP:	CALL	GET		; Get record
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,NOREC		; Not an active record, so no user
	LD	HL,UNAMEF	; See if to user
	LD	DE,INBUF
	LD	A,(LINES)
	LD	B,A
	CALL	MATCH
	OR	A
	JP	Z,UPLP0
	LD	HL,(RRNO)
	INC	HL
	EX	DE,HL
	LD	HL,(HSHREC)
	XOR	A		; Clear carry
	SBC	HL,DE
	JR	Z,NOREC1	; Checked all records, none free
	LD	HL,MAXU
	XOR	A		; Clear carry
	SBC	HL,DE		; Done with records?
	EX	DE,HL		; Get record back
	JR	NZ,GLOOP
	LD	HL,0		; Load up first record in file
	JR	GLOOP		; No, keep going
;.....
;
NOREC:	CALL	PRINT
	DEFB	CR,'Not found... Add user to file(?) ',0
	CALL	GETCH
	CALL	CAPS
	CALL	ECHO
	CP	'Y'
	JR	NZ,NOREC2	; If not, continue normally
	LD	HL,INBUF
	LD	DE,UNAMEF
	LD	BC,29
	LDIR
	LD	HL,BDATE
	LD	DE,LSTONF
	LD	BC,3
	LDIR
	LD	A,1
	LD	(AVAILF),A	; Show used record
	LD	HL,(IUSER)
	INC	HL		; Bump user count
	LD	(IUSER),HL
	LD	HL,(RRNO)	; Display the new record
	JP	UPLP1		; Got display it for editing
;.....
;
NOREC1:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'No available records, rehash and try again..',0
;
NOREC2:	LD	HL,(TRECNO)
	JP	UPLP		; Go back to closest record
;.....
;
LREQD:	CALL	PRINT
	DEFB	'First and Last name required',CR,LF,0
	JP	GOTO
;.....
;
PHN:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'New phone number? ',0
	LD	B,12
	LD	C,20H
	LD	D,0
	XOR	A
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	DE,PHONEF
	LD	BC,12
	LDIR			; Move new password to buffer
	JP	UWRT		; And write record
;.....
;
UWT2:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'New password? ',0
	LD	B,10
	LD	C,20H
	LD	D,0
	XOR	A
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	DE,PSWRDF
	LD	BC,10
	LDIR			; Move new password to buffer
	JP	UWRT		; And write record
;.....
;
UWT3:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Last name must start with same character '
	DEFB	'as current:',CR,LF
	DEFB	'New name? ',0
	LD	B,NAMLEN
	LD	C,20H
	LD	D,0
	XOR	A
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	DE,UNAMEF
	LD	BC,NAMLEN
	LDIR			; Move name to buffer
	JP	UWRT		; And write record
;.....
;
UWT4:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'New city, state? ',0
	LD	B,20
	LD	C,20H
	LD	D,0
	XOR	A
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	DE,CITSTF
	LD	BC,20
	LDIR			; Move location to buffer
	JP	UWRT		; And write record
;.....
;
IDU:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Drive letter? ',0
;
IDU1:	CALL	GETCH
	CP	CR
	JP	Z,UPLP0
	CALL	CAPS
	CALL	ECHO
	CP	'A'
	JP	C,IDU
	CP	'P'+1
	JP	NC,IDU
;
	SUB	'A'
	PUSH	AF		; Save drive as number 0-f
	CALL	PRINT
	DEFB	' -> User area? ',0
	LD	B,2
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	CP	2		; How many characters?
	JR	Z,IDU2
	CP	1
	JR	Z,IDU2
	POP	AF		; Fix stack back up
	JP	IDU		; Illegal entry - do it again
;...
;
IDU2:	LD	(CNVRT0+1),A	; Set number characters to convert
	PUSH	HL
	POP	IX		; Pointer to ix
	CALL	CNVRT0		; Make string binary number
	LD	A,2
	LD	(CNVRT0+1),A	; Restore code
	LD	A,L		; Get binary number
	RLCA
	RLCA
	RLCA
	RLCA			; Move to upper 4 bits
	PUSH	AF
	POP	BC		; User in upper 4 bits of b
	POP	AF		; Get drive back
	AND	00001111B
	ADD	A,B		; Merge drive/user
	LD	(INTARF),A
	JP	UWRT
;.....
;
MWF:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Number of messages waiting: ',0
	LD	B,5
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	LD	A,L
	LD	(MAILF),A	; Store new mail number
	JP	UWRT
;.....
;
TMO:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Number times on? ',0
	LD	B,5
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	OR	A
	JP	Z,UPLP0
	LD	(CNVRT0+1),A	; Set number of bytes to convert
	PUSH	HL
	POP	IX
	CALL	CNVRT0
	LD	A,2
	LD	(CNVRT0+1),A
	LD	(TMSONF),HL	; Store new times on
	JP	UWRT
;.....
;
LSTO:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Enter last date on as mm/dd/yy: ',0
	LD	B,8
	LD	A,0
	LD	C,0
	LD	D,0
	CALL	INPUT
	CP	8
	JP	C,LSTERR
	LD	BC,8
	LD	DE,DATE
	LDIR
	CALL	CDATE		; Make string binary
	LD	HL,BDATE
	LD	DE,LSTONF
	LD	BC,3
	LDIR
	JP	UWRT
;.....
;
LSTERR:	CALL	PRINT
	DEFB	' <-- MUST be 8 characters',0
	LD	HL,(RRNO)
	JP	UPLP
;.....
;
UWT1:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'New level? ',0
;
UWT1A:	CALL	GETCH
	CP	CR
	JP	Z,UPLP0
	CP	'0'
	JR	C,UWT1
	CP	'9'+1
	JR	NC,UWT1
	CALL	ECHO
	SUB	'0'		; Convert to binary
	PUSH	AF
	LD	B,A
	LD	A,(ACCTMP)
	CP	B
	JP	Z,UPLP0		; No change
	JR	C,UP		; Increased
	POP	AF		; Get back new level
	PUSH	AF		; And save it again
	OR	A		; Now deleted?
	JR	Z,U2		; Yes
	JR	UMTND
;
UP:	LD	A,(ACCTMP)
	CP	0		; Was it deleted before?
	JR	NZ,UMTND	; No
;
U1:	LD	HL,(IUSER)	; Increase # users by one
	INC	HL
	LD	(IUSER),HL
	JR	UMTND
;
U2:	LD	HL,(IUSER)	; Lower # users by one
	DEC	HL
	LD	(IUSER),HL
;
UMTND:	POP	AF		; Get back access level
	LD	(ACESSF),A
;
UWRT:	LD	HL,(RRNO)
	CALL	PUT
	LD	HL,(RRNO)
	JP	UPLP
;.....
;
MBPREC:	LD	HL,(RRNO)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	Z,MUDON		; No
	CALL	GET		; Get record
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,MBPREC	; Not an active record, so keep going
	LD	A,(DLEVEL)
	CP	0FFH
	JP	Z,UPLP0
	LD	HL,DLEVEL
	LD	A,(ACESSF)	; Get user level
	CP	(HL)
	JR	NZ,MBPREC	; Get the next one
	LD	HL,(RRNO)
	DEC	HL
	JP	UPLP0
;.....
;
MUDON:	CALL	CLOSE		; Close
	CALL	EATCHR
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'User maintenance completed',0
	CALL	GETRTC
	CALL	CDATE
	CALL	CTIME		; Binary date & time set
	LD	HL,BTIME
	LD	DE,MUSRT
	LD	BC,3
	LDIR			; Set time
	LD	HL,BDATE
	LD	DE,MUSRD
	LD	BC,3
	LDIR			; Set date
;
HLGDON:	LD	HL,IDATE
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR
	CALL	IOPEN
	CALL	PUT		; Update index
	CALL	CLOSE
	JP	SYS1
;.....
;
BACKU:	LD	DE,MAXU
	DEC	DE
;
BACK:	INC	DE		; Set for compare
	LD	HL,(RRNO)
	INC	HL
	XOR	A		; Cleary carry
	SBC	HL,DE
	JP	NC,MBPREC	; Hl>DE so forget it
	LD	HL,(RRNO)
	INC	HL
	CALL	GET
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,BUNXT		; Not an active record, so keep going
	LD	A,(DLEVEL)
	CP	0FFH
	JP	Z,UPLP0
;
	LD	HL,DLEVEL
	LD	A,(ACESSF)	; Get user level
	CP	(HL)
	JR	NZ,BUNXT	; Get the next one
	LD	HL,(RRNO)
	INC	HL
	JP	UPLP0
;.....
;
BUNXT:	LD	HL,(RRNO)
	JP	BACKU
;
MMSG:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Message file last maintained:  ',0
	LD	IX,MMSGT	; Point at user maintenance time
	CALL	PTIME
	CALL	PRINT
	DEFB	' on ',0
	LD	IX,MMSGD	; Point to user maintenance date
	CALL	PDATE
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Show deleted messages? ',0
	XOR	A
	LD	(SHDEL),A
;
READMP:	CALL	GETCH
	CALL	CAPS
	CP	'N'
	JR	Z,READ1MP
	LD	A,-1
	LD	(SHDEL),A
	LD	A,'Y'
;
READ1MP:CALL	ECHO
	LD	DE,(MSGARR)	; Point to messages table
	PUSH	DE
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Please wait, loading...',0
	CALL	MOPEN
	LD	HL,(IMNDX)	; Start record
;
MRDLP:	CALL	GET
	LD	A,(MREAD)
	CP	0FFH		; Message deleted?
	JP	NZ,MRDLP3
	LD	A,(SHDEL)	; Yes, showing deleted messages?
	OR	A
	JP	Z,BMPREC	; No
;
MRDLP3:	LD	HL,MNUMF	; No
	POP	DE		; Get current pointer
	LD	BC,MTABLEN
	LDIR			; Save message info
	LD	HL,(RRNO)	; Get actual record number in msgindex
	LD	A,L
	LD	(DE),A
	LD	A,H
	INC	DE
	LD	(DE),A		; Record number is last two bytes of entry
	INC	DE		; Point to beginning of next entry
	PUSH	DE		; New pointer so save and ...
;
BMPREC:	LD	HL,(RRNO)	; Get record
	DEC	HL		; And drop it by one
	LD	A,H
	CP	0FFH		; See if any more
	JP	NZ,MRDLP	; Yes
	CALL	CLOSE
	POP	IY		; Get end of array (was DE )
	LD	(IYEND),IY	; Save end of aray
;
PMSGS:	LD	IY,(MSGARR)	; Point to table
	LD	HL,MESSAGES
	CALL	OPEN		; Open MESSAGES.BBS file
	LD	HL,MSGLEN
	LD	(RRSZ),HL	; Set record length
;
; Main Loop
;
MLOP1:	PUSH	IY
	POP	HL
	LD	DE,(IYEND)
	XOR	A
	SBC	HL,DE
	JP	Z,NOMOR
;
PM01:	XOR	A
	LD	(DELFLG),A
	CALL	@PRNT
	DEFB	CR,LF,CR,LF
;
	 IF	NMAREAS	GT 1
	DEFB	'Area: ',0
	LD	L,(IY+67)
	LD	H,0
	CALL	PB2ASC
	CALL	@PRNT
	DEFB	', '
	 ENDIF			; NMAREAS GT 1
;
	DEFB	'Message number ',0
	LD	(IYHOLD),IY
	LD	A,(IY)
	LD	L,A
	LD	A,(IY+1)
	LD	H,A
	CALL	PB2ASC
	LD	A,(IY+68)
	CP	0FFH		; Is it still zero
	JR	NZ,PM02		; No
	CALL	@PRNT		; Yes.........
	DEFB	' =D=',0
	LD	A,0FFH
	LD	(DELFLG),A
	JR	PM03
;
PM02:	CP	1
	JP	NZ,PM03
	CALL	@PRNT
	DEFB	' (R)',0
;
PM03:	CALL	@PRNT
	DEFB	', dated ',0
	PUSH	IY
	POP	IX
	LD	BC,2
	ADD	IX,BC
	CALL	PDATE
	LD	A,(IY+66)
	OR	A
	JR	Z,PM04
	CALL	PRINT
	DEFB	' <P>',0
;
PM04:	LD	A,(IY+5)
	LD	B,A		; Number of lines (records) to 'B'
	PUSH	BC		; Save it as BC
	LD	A,(IY+6)	; Get starting record number
	LD	L,A		; Into HL
	LD	A,(IY+7)
	LD	H,A
	LD	(RRNO),HL	; And random parameter block
	LD	A,(IY+8)	; Move LSB of record # to L
	LD	L,A
	LD	A,(IY+9)	; Move MSB of record number to H
	LD	H,A
	LD	(CURREC),HL	; Save it for kill routine
	CALL	@PRNT
	DEFB	CR,LF,'Subject: ',0
	PUSH	IY
	POP	HL
	LD	BC,10
	ADD	HL,BC
	LD	B,26
	CALL	@PRNTL
	PUSH	IY
	POP	HL
	LD	DE,71		; Get passed subject and To: field
	ADD	HL,DE		; And point to record number in msgindex
	PUSH	HL
	POP	IY		; Updated and into iy
	LD	DE,(MSG)	; Point to message buffer
	POP	BC		; Recover line count
;
MLOP2:	PUSH	BC		; Save counter
	PUSH	DE		; And pointer to buffer location
	LD	HL,(RRNO)
	CALL	GET
	LD	HL,RNDBUF
	LD	BC,MSGLEN
	POP	DE		; Get buffer address
	LDIR
	LD	HL,(RRNO)
	INC	HL		; Next line (record)
	LD	(RRNO),HL
	POP	BC		; Get counter
	DJNZ	MLOP2
	CALL	LIST		; And print it to console
	CALL	PRINT
	DEFB	CR,LF,0
	CALL	PRINT
	DEFB	'Exit, Goto, Next, Previous, Toggle pub/priv',0
	XOR	A
	LD	(KF),A
	LD	(CF),A
	LD	(UF),A
	LD	A,(DELFLG)
	OR	A
	JR	NZ,MLOP2B
;
MLOP2A:	CALL	PRINT
	DEFB	', Delete',0
	LD	A,0FFH
	LD	(KF),A
	LD	A,(SHDEL)
	LD	B,A
	LD	A,NMAREAS
	DEC	A
	ADD	A,B
	JR	Z,MLOP4
;
MLOP2B:	LD	A,(SHDEL)
	OR	A
	JR	Z,MLOP3
	LD	A,(DELFLG)
	OR	A
	JR	Z,MLOP3
	CALL	PRINT
	DEFB	' Undelete',0
	LD	A,0FFH
	LD	(UF),A
;
MLOP3:	LD	A,NMAREAS
	DEC	A
	JR	Z,MLOP4
	CALL	PRINT
	DEFB	', Area change',0
	LD	A,0FFH
	LD	(CF),A
;
MLOP4:	CALL	PRINT
	DEFB	': ',0
;
PWAIT:	CALL	GETCH
	CP	CR
	JP	Z,MLOP1
;
	CALL	CAPS
	CALL	ECHO
	CP	'E'
	JP	Z,DONEM
	CP	'G'
	JP	Z,MGOTO
	CP	'N'
	JP	Z,BACKM
	CP	'P'
	JP	Z,MLOP1
	CP	'T'
	JP	Z,TPP
	PUSH	AF
	LD	A,(KF)
	OR	A
	JR	Z,PWAIT1
	POP	AF
	CP	'D'
	JP	Z,MKILL
	PUSH	AF
;
PWAIT1:	LD	A,(UF)
	OR	A
	JR	Z,PWAIT2
	POP	AF
	CP	'U'
	JP	Z,UNDEL
	PUSH	AF
;
PWAIT2	EQU	$
;
	 IF	(NMAREAS GT 1)
	LD	A,(CF)
	OR	A
	JR	Z,PWAIT3
	POP	AF
	CP	'A'
	JP	Z,CAREA
	CALL	PRINT
	DEFB	BS,' ',BS,0
	JR	PWAIT
	 ENDIF			; NMAREAS GT 1
;
PWAIT3:	POP	AF
	CALL	PRINT
	DEFB	BS,' ',BS,0
	JR	PWAIT
;...
;
MGOTO:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Goto the B)eginning or E)nd of message base: ',0
	CALL	GETCH
	JP	Z,MLOP1
	CALL	CAPS
	CALL	ECHO
	CP	'B'
	JP	Z,MSBEGN
	CP	'E'
	JP	Z,MSEND
	CALL	PRINT
	DEFB	BS,' ',BS,0
	JR	MGOTO
;
MSBEGN:	LD	HL,(IYEND)
	LD	DE,MTABLEN+2	; Get back to start of header
	SBC	HL,DE
	PUSH	HL
	POP	IY		; Updated and into iy
	JP	MLOP1
;
MSEND:	LD	IY,(MSGARR)
	JP	MLOP1
;....
;
; Delete routine
;
MKILL:	CALL	MLCOM1		; Open MSGINDEX in order to kill message
	LD	HL,(CURREC)
	CALL	GET
	LD	A,0FFH		; Clearing message number
	LD	(MREAD),A
	LD	HL,(RRNO)	; (Restore record number)
	CALL	PUT		; And writing record back
	CALL	CLOSE		; MSGINDEX.BBS, done kill so now check
				;   user mail flag
	CALL	MF1		; Open USERS.BBS, Get a user record mail
	OR	A		;   flag
	JR	NZ,DMF2		; Didn't find one
	LD	A,(MAILF)
	OR	A
	JR	Z,DMF1		; Already zero, bail out
	DEC	A
	LD	(MAILF),A	; Dec it by one
	LD	HL,(RRNO)	; Get record number
	CALL	PUT
;
DMF1:	CALL	CLOSE		; USERS.BBS
;
DMF2:	CALL	MLCOM2		; Open MESSAGES.BBS file
	LD	IY,(IYHOLD)
	LD	A,0FFH
	LD	(IY+68),A
	JP	MLOP1		; Go check for next message data
;.....
;
; Un-delete a message and then update the actual record
;
UNDEL:	CALL	MLCOM1		; Close MESSAGES.BBS, open MSGINDEX.BBS
	LD	HL,(CURREC)
	CALL	GET
	XOR	A
	LD	(MREAD),A	; Renumber this message
	LD	HL,(RRNO)
	CALL	PUT
	CALL	CLOSE		; Close MSGINDEX.BBS
;
IMF1:	CALL	MF1
	OR	A
	JR	NZ,IMF2
	LD	A,(MAILF)
	INC	A
	LD	(MAILF),A
	LD	HL,(RRNO)	; Get record number
	CALL	PUT
	CALL	CLOSE
;
IMF2:	LD	HL,IDATE	; Prepare for update
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR
	CALL	IOPEN		; INDEX.BBS
	CALL	PUT
	CALL	CLOSE		; INDEX.BBS, done with it
	CALL	MLCOM2		; OPEN MESSAGES. BBS
	LD	IY,(IYHOLD)
	XOR	A
	LD	(IY+68),A
	JP	MLOP1		; And go back and redisplay message
;.....
;
; Subroutine:  Get the receiver's mail flag for update, returns 0FFH
; if no user found, 0 if valid user.
;
MF1:	LD	HL,MTOF		; Store the the receiver's name
	LD	DE,MTOTMP
	LD	BC,NAMLEN
	LDIR
	CALL	UOPEN		; Open USERS.BBS
	LD	HL,MTOTMP	; Get 'To: ' name
;
MF2:	LD	A,(HL)		; Get a character
	INC	HL		; Next character
	OR	A		; See if it's a null (error)
	JP	Z,MF4		; Not valid, so ignore
	CP	' '		; See if it's a space
	JR	NZ,MF2
	LD	A,(HL)		; Get first character of last name
	CP	'A'		; Check for valid character
	JP	C,MF4		; Not valid, so ignore
	CP	'Z'+1
	JP	NC,MF4		; Not valid, so ignore
	CALL	HASH		; Calc starting position in USERS.BBS
	LD	(HSHREC),HL
	LD	HL,(HSHREC)
;
; We now have the beginning hashed record for this user probe
;
MF3:	CALL	GET		; Get record from the USERS.BBS file
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,MF4		; Not an active record, so no user
	LD	HL,UNAMEF
	LD	DE,MTOTMP
	LD	B,NAMLEN
	CALL	MATCH
	OR	A
	RET	Z		; Got a match, fix the flag
	LD	HL,(RRNO)
	INC	HL
	EX	DE,HL
	LD	HL,(HSHREC)	; See if we've come all the way around
	SBC	HL,DE
	JR	Z,MF4		; We have...bail out.
	LD	HL,MAXU		; See if we are at the end of the file
	XOR	A
	SBC	HL,DE
	EX	DE,HL
	JR	NC,MF3		; More to go..
	LD	HL,0		; Load up 0 record
	JR	MF3		; And keep going
;
MF4:	CALL	CLOSE		; USERS.BBS file
	LD	A,0FFH		; Didn't find anything, set flag, done
	RET
;.....
;
	 IF	(NMAREAS GT 1)
CAREA:	CALL	PRINT
	DEFB	CR,LF,'Select a NEW area number from '
	DEFB	'the following list: '
	DEFB	CR,LF,'1: ',0
	LD	HL,ANAME1
	LD	BC,11
	CALL	PRINTL
	CALL	PRINT
	DEFB	CR,LF,0
	CALL	DAREA2
	CALL	PRINT
	DEFB	'Enter NEW area number or <ret>: ',0
;
CAREA2:	CALL	GETCH
	CALL	CAPS
	CALL	ECHO
	CP	CR
	JP	Z,MLOP1
	CP	'1'
	JR	C,CAREA2
	CP	NMAREAS+031H
	JR	NC,CAREA2
	SUB	'0'		; Convert to binary
	LD	(NEWAREA),A
	CALL	MLCOM1		; Close MESSAGES.BBS, open MSGINDEX.BBS
	LD	A,(NEWAREA)
	LD	(MANUMF),A
	LD	IY,(IYHOLD)
	LD	(IY+67),A
	LD	HL,(RRNO)	; Set record number
	CALL	PUT
	CALL	CLOSE
	CALL	MLCOM2
	JP	MLOP1		; And go back and redisplay message
	 ENDIF			; NMAREAS GT 1
;.....
;
TPP:	CALL	MLCOM1		; Close MESSAGES.BBS, open MSGINDEX.BBS
	LD	A,(MPUBF)
	XOR	1
	LD	(MPUBF),A
	PUSH	IY
	LD	IY,(IYHOLD)
	LD	(IY+66),A
	POP	IY
	LD	HL,(RRNO)
	CALL	PUT
	CALL	CLOSE
	CALL	MLCOM2
	JP	MLOP1
;...
;
MLCOM1:	CALL	CLOSE		; Close MESSAGES.BBS file, during kill
	CALL	MOPEN		; Open MSGINDEX.BBS
	LD	HL,(CURREC)	; Get pointer to MSGINDEX.BBS record #
	LD	(RRNO),HL	; Reading it
	CALL	GET
	RET
;...
;
MLCOM2:	LD	HL,MESSAGES	; OPEN MESSAGES.BBS
	CALL	OPEN
	LD	HL,MSGLEN
	LD	(RRSZ),HL
	RET
;...
;
LIST:	CALL	@PRNT
	DEFB	CR,LF,CR,LF,0
	XOR	A
	LD	(COLUMN),A	; Set column counter
	LD	HL,(MSG)	; Point to buffer
;
LSTLOP:	LD	A,(HL)
	OR	A
	RET	Z		; 0=end
	CP	1		; 1 is used as a pad char for first 2 records
	JR	Z,LSTSKP	; And to allow easy conversion of old messages
	CP	CR		; Carriage return?
	CALL	Z,LSTCR
	CP	' '		; Space?
	CALL	Z,LSTWRP	; See if wrap time
	CALL	@ECHO		; Echo character
	PUSH	HL
	LD	E,0FFH
	LD	C,DIRCON
	CALL	SPBDOS		; See if we want to pause / restart
	OR	A
	CALL	NZ,LSTPSE	; Yes
	POP	HL
	INC	HL
	LD	A,(COLUMN)	; Update current column
	INC	A
	CP	80		; At end of line?
	JR	C,LST0		; Nope
	XOR	A		; Yep so reset
;
LST0:	LD	(COLUMN),A
	JR	LSTLOP
;.....
;
LSTSKP:	INC	HL		; Point at next character
	JR	LSTLOP		; And check it out
;.....
;
LSTWRP:	LD	A,(COLUMN)
	CP	69		; <<<=== wrap point at linelength-15
	LD	A,' '		; In case
	RET	C		; Less so return
	XOR	A
	LD	(COLUMN),A	; Reset column count
	LD	A,CR
	CALL	@ECHO		; Do carriage return
	LD	A,LF		; Get linefeed
	RET			; And return to print it
;.....
;
LSTCR:	CALL	@ECHO		; Do <ret>
	XOR	A
	LD	(COLUMN),A	; Reset counter
	LD	A,LF		; Return to print linefeed
	RET
;.....
;
LSTPSE:	CALL	GETCH		; Wait for another character
	RET			; Back to the farm...
;.....
;
COLUMN:	DEFB	0		; Counter byte
;
NOMOR:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Finished',0
;
DONEM:	JP	NORNM		; Finish up the time/date work
;.....
;
; Renumber the messages and update the USERS.BBS highest message read
;
RENUM:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Renumber messages? ',0
;
RNMWT:	CALL	GETCH
	CALL	CAPS
	CP	'A'
	JR	C,RNMWT
	CALL	ECHO
	CP	'Y'
	JP	NZ,SYS1		; Exit for anything but "Y" for Yes
;
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Renumbering messages....',0
	CALL	MOPEN		; Open MSGINDEX.BBS
	LD	HL,(IMNDX)	; Get # of records in MSGINDEX.BBS
	LD	(ENDF),HL	; Store for end of our special listing
	LD	HL,0
	LD	IX,1		; Starting number
	LD	IY,(MSGARR)	; Point to start of array
;
RNMLP:	CALL	GET		; Read record from MSGINDEX.BBS
	LD	HL,(MNUMF)	; Put old number
	LD	(IY),L		; Into array
	LD	(IY+1),H
	LD	(MNUMF),IX	; Change message number
	INC	IX		; For next time
	LD	HL,(MNUMF)
	LD	(IY+2),L	; New number to array as well
	LD	(IY+3),H
	LD	HL,(RRNO)
	CALL	PUT		; Write record back to MSGINDEX.BBS
	LD	HL,(RRNO)	; Get current record number
	INC	HL
	LD	DE,(ENDF)	; Get last record number (end)
	INC	DE
	AND	A
	SBC	HL,DE		; See if all done
	JP	NC,RNMDN	; If so, go wrap it up
	LD	HL,(RRNO)	; Else, increment the current record number
	INC	HL
	LD	(RRNO),HL
	LD	BC,4		; Adjust array pointer
	ADD	IY,BC
	JP	RNMLP		; And keep going
;.....
;
RNMDN:	CALL	CLOSE		; MSGINDEX.BBS
	LD	(IMNXT),IX
;
USNUM:	CALL	PRINT
	DEFB	CR,LF,'Updating users file...',CR,LF,0
	CALL	UOPEN		; Open USERS.BBS file
	LD	HL,MAXU		; Number of records
	DEC	HL
	LD	(RRNO),HL
;
USNLP:	CALL	GET
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,USNXT		; Not an active record, so do next one
	LD	IY,(MSGARR)	; Point to start of array
	LD	BC,(HIMSGF)	; Get old 'high message pointer'
	CALL	SEARCH		; Find new number in array
	LD	(HIMSGF),BC	; Update user record
	LD	HL,(RRNO)	; And put it
	CALL	PUT		; Back in USERS.PBS
;
USNXT:	CALL	PRINT
	DEFB	'.',0
	LD	HL,(RRNO)
	DEC	HL
	LD	(RRNO),HL
	LD	A,H
	CP	0FFH		; Done with records?
	JR	NZ,USNLP	; If not, do another
;
NORNM:	CALL	CLOSE		; Close the file
	CALL	GETRTC		; Get current time and date
	CALL	CTIME
	CALL	CDATE		; Time and date to binary
	LD	DE,MMSGT	; Point to time in index
	LD	HL,BTIME	; Point to binary time
	LD	BC,3
	LDIR			; Move
	LD	DE,MMSGD	; Point to date in index
	LD	HL,BDATE	; And binary
	LD	BC,3
	LDIR			; Move it
;
	LD	HL,IDATE
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR			; Move index to buffer
	CALL	IOPEN
	CALL	PUT		; Update index
	CALL	CLOSE		; Close the INDEX.BBS file
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Finished',CR,LF,0
	JP	SYS1		; All done
;.....
;
BACKM:	PUSH	IY
	POP	HL
	LD	DE,71
	AND	A		; Clear carry
	SBC	HL,DE		; Points to current message
	SBC	HL,DE		; Points to previous
	PUSH	HL		; Save in case ok
	LD	DE,(MSGARR)	; See if passed start of array
	AND	A		; Clear carry
	SBC	HL,DE		; Ok?
	JP	NC,BACKM1	; Hl>=de = ok
	LD	HL,(MSGARR)	; Point to start
	POP	IY		; Clear stack
	PUSH	HL		; Save new pointer
;
BACKM1:	POP	IY		; Get new pointer
	JP	MLOP1
;.....
;
MHLG:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Hard-log now ',0
	LD	A,(SYSLOG)
	CP	1
	JP	NZ,LGOFF
	CALL	PRINT
	DEFB	'ON',0
	JP	MHLG1
;...
;
LGOFF:	CALL	PRINT
	DEFB	'OFF',0
;
MHLG1:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Enter E to quit, N for on, F for off: ',0
;
MHWT:	CALL	GETCH
	CALL	CAPS
	CP	'E'
	JP	Z,HLGDON
	CP	'F'
	JP	Z,OFF
	CP	'N'
	JP	Z,ON
	JP	MHWT
;.....
;
OFF:	CALL	ECHO
	XOR	A
	JR	NFDON
;.....
;
ON:	CALL	ECHO
	LD	A,1
;
NFDON:	LD	(SYSLOG),A
	JP	MHLG
;.....
;
BHLG:	CALL	@PRNT
	DEFB	CR,LF,CR,LF
	DEFB	'BYE Hard-log now ',0
	LD	A,(HRDLOG)
	CP	1
	JP	NZ,BLGOFF
	CALL	@PRNT
	DEFB	'ON.',0
	JP	BHLG1
;...
;
BLGOFF:	CALL	@PRNT
	DEFB	'OFF',0
;
BHLG1:	CALL	@PRNT
	DEFB	CR,LF,CR,LF
	DEFB	'Enter E to exit, N for on, O for off: ',0
;
BHWT:	CALL	GETCH
	CALL	CAPS
	CP	'E'
	JP	Z,HLGDON
	CP	'N'
	JP	Z,BON
	CP	'O'
	JP	Z,BOFF
	JP	BHWT
;.....
;
BOFF:	CALL	@ECHO
	XOR	A
	JR	BFDON
;...
;
BON:	CALL	@ECHO
	LD	A,1
;
BFDON:	LD	(HRDLOG),A
	JP	BHLG
;.....
;
PCALRS:	CALL	PRINT
	DEFB	CR,LF,0
	LD	HL,CALWRK
	CALL	OPEN
	CP	0FFH		; Did it exist?
	JR	NZ,PCAL1
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'CALLERS file not found',CR,LF,0
	JP	SYS1		; Back to the menu
;.....
;
PCAL1:	CALL	CLOSE
	LD	HL,CALRS2	; Initialize pointer to CALLERS.BAK"
	CALL	BFCB
	LD	DE,FCB		; Kill CALLERS.BAK if there
	CALL	KILBDOS
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Renaming CALLERS     to CALLERS.BAK',0
	LD	DE,RENC1
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
	CALL	PCAL2
	JP	SYS1		; Back to the menu
;.....
;
PCAL2:	CALL	PRINT
	DEFB	CR,LF,'Xferring CALLERS.BAK to CALLERS...',0
	LD	HL,CALRS2
	CALL	OPEN
	LD	HL,CALWRK
	CALL	OPEN2
	LD	HL,64		; Get length of each record
	LD	(RRSZ),HL	; Into source param block
	LD	(RRSZ2),HL	; And dest param block
	LD	HL,0		; Get record number
	CALL	GET
	LD	HL,(RNDBUF)	; Is first 2 bytes of record 0
	XOR	A		; Clear the carry
	LD	DE,50		; One extra for pre-increment
	SBC	HL,DE
	JP	M,SMCALR	; Callers file too small to pack
	LD	(RRNO),HL	; Our starting record #
	LD	A,50
	LD	(LINES),A	; We copy 50 or less
	LD	IX,1		; Start with record 1
;
PCAL4:	LD	A,(LINES)
	DEC	A
	LD	(LINES),A
	JP	Z,PCALEND
	LD	HL,(RRNO)
	INC	HL
	CALL	GET
	PUSH	IX
	POP	HL		; Get record number to write
	INC	IX		; Point to next record
	CALL	PUT2		; Write new record
	JR	PCAL4
;...
;
PCALEND:CALL	CLOSE
	LD	HL,0		; Record zero is the counter
	LD	(RNDBUF),IX
	CALL	PUT2
	CALL	CLOSE2
;
	 IF	NOT SAVBAK
	LD	HL,CALRS2	; CALLERS.BAK
	CALL	BFCB		; Move name to FCB area
	LD	DE,FCB		; Then kill that file, if present
	CALL	KILBDOS
	 ENDIF			; NOT SAVBAK
;
	CALL	PRINT
	DEFB	'.done',0
	RET
;.....
;
SMCALR:	CALL	CLOSE		; Close everthing
	CALL	CLOSE2		; Ditto
	LD	HL,CALWRK	; Initialize pointer to CALLERS"
	CALL	BFCB
	LD	DE,FCB		; Kill CALLERS if there
	CALL	KILBDOS
	CALL	PRINT
	DEFB	CR,LF,'CALLER file too small',CR,LF
	DEFB	'Renaming CALLERS.BAK to CALLERS.....',0
	LD	DE,RENC2
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
	RET
;.....
;
PACK:	CALL	PRINT
	DEFB	CR,LF,CR,LF,'Delete (R) msgs over ',0
	LD	HL,DAYS
	CALL	PB2ASC
	CALL	PRINT
	DEFB	' days old? ',0
	CALL	GETCH
	CALL	CAPS
	CP	'N'
	JP	Z,PACK5
	CALL	MOPEN
	LD	HL,(IMNDX)
	LD	(RRNO),HL
;
	CALL	PRINT
	DEFB	'Yes',CR,LF,CR,LF
	DEFB	'Number of messages ........... ',0
	LD	HL,(RRNO)
	INC	HL		; Compensate for 1st msg in record 0
	LD	(RTTL),HL
	CALL	PB2ASC
	CALL	PRINT
	DEFB	CR,LF,'Please wait...',0
;
	LD	HL,(RRNO)	; Get record number (last one in file)
;
PACK1:	CALL	GET		; Put information into memory
	LD	A,(MREAD)	; See if this message was read yet
	CP	1		; 1 = has been read
	JR	NZ,PACK2	; If deleted or not read, exit
	LD	HL,(RREAD)	; Increment "was read" counter
	INC	HL
	LD	(RREAD),HL
	LD	IY,IDATE	; Today's date
	LD	IX,MDATF	; Date of message in current record
	CALL	DATDIF		; Returns difference in HL pair
	LD	DE,DAYS		; Put number of days in 'DE'
	XOR	A		; Clear carry
	SBC	HL,DE		; Subtract from date of this message
	JR	C,PACK2		; Less than 'days' time so ignore
	LD	A,-1
	LD	(MREAD),A	; Else delete this message
	LD	HL,(RRNO)
	CALL	PUT		; Store the value
	LD	HL,(CHANGED)	; Increment "messages deleted" counter
	INC	HL
	LD	(CHANGED),HL
	LD	HL,(RTOTAL)	; Increment "total deleted" counter
	INC	HL
	LD	(RTOTAL),HL
	JR	PACK3
;
PACK2:	LD	A,(MREAD)
	CP	-1
	JR	NZ,PACK3
	LD	HL,(RDELTD)	; Increment "already deleted" counter
	INC	HL
	LD	(RDELTD),HL
	LD	HL,(RTOTAL)	; Increment "total deleted" counter
	INC	HL
	LD	(RTOTAL),HL
;
PACK3:	LD	HL,(RRNO)
	LD	A,H
	OR	L
	JR	Z,PACK4
	DEC	HL
	LD	(RRNO),HL
	JP	PACK1
;
PACK4:	CALL	PRINT
	DEFB	CR
	DEFB	'Number of messages read ...... ',0
	LD	HL,(RREAD)
	CALL	PB2ASC
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Number of =D= msgs deleted ... ',0
	LD	HL,(RDELTD)
	CALL	PB2ASC
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Number of (R) msgs deleted ... ',0
	LD	HL,(CHANGED)
	CALL	PB2ASC
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Total  number msgs deleted ... ',0
	LD	HL,(RTOTAL)
	CALL	PB2ASC
;
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'         messages retained ..  ',0
	LD	HL,(RTOTAL)
	EX	DE,HL
	LD	HL,(RTTL)
	SBC	HL,DE
	CALL	PB2ASC
	CALL	CLOSE
	JR	PACK6
;...
;
CHANGED:DEFW	0		; # of msgs changed from read to deleted
RDELTD:	DEFW	0		; # of msgs manually deleted
RREAD:	DEFW	0		; # of msgs that have been read
RTOTAL:	DEFW	0		; Total # of messages deleted this time
RTTL:	DEFW	0		; Total original messages
;...
;
PACK5:	CALL	ECHO
;
PACK6:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Takes about 18k/minute for very fast systems',CR,LF
	DEFB	'Takes about 10k/minute (or more) for slow ones',0
	LD	HL,NDXWRK
	CALL	BFCB
	LD	DE,FCB
	CALL	KILBDOS
;
	LD	HL,MSGIN2
	CALL	BFCB
	LD	DE,FCB
	CALL	KILBDOS
;
	LD	HL,MESSA2
	CALL	BFCB
	LD	DE,FCB
	CALL	KILBDOS
;
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Renaming INDEX.BBS    to INDEX.BAK',0
	LD	DE,RENI1
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Renaming MSGINDEX.BBS to MSGINDEX.BAK',0
	LD	DE,RENX1
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Renaming MESSAGES.BBS to MESSAGES.BAK',0
	LD	DE,RENM1
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
;
NOCLR:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Xferring INDEX.BAK    to INDEX.BBS......',0
	LD	HL,NDXWRK
	CALL	OPEN
	LD	HL,INDEX
	CALL	OPEN2
	LD	HL,NDXLEN
	LD	(RRSZ),HL
	LD	(RRSZ2),HL
	LD	HL,0		; Get old index
	CALL	GET
	LD	HL,0
	CALL	PUT2
	CALL	CLOSE
	CALL	CLOSE2
	CALL	PRINT
	DEFB	'done',0
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Xferring MSGINDEX.BAK to MSGINDEX.BBS...'
	DEFB	CR,LF,0
	LD	HL,MSGIN2
	CALL	OPEN
	LD	HL,MSGWRK
	CALL	OPEN2
	LD	HL,MNDXLEN	; Get length of each record
	LD	(RRSZ),HL	; Into source param block
	LD	(RRSZ2),HL	; And dest param block
	LD	HL,(IMNDX)
	LD	(ENDF),HL
	LD	HL,0
	LD	IX,0		; Starting number for destination
;
PMILP:	CALL	GET		; Get message index record
	LD	A,(MREAD)	; See if active
	CP	0FFH
	JP	Z,PMIBMP	; Inactive so don't write new record
;
	PUSH	IX
	POP	HL		; Get record number to write
	LD	A,L
	LD	(MRECF),A	; Reset the actual record number
	LD	A,H
	LD	(MRECF+1),A
	INC	IX		; Point to next record
	CALL	PUT2		; Write new record
	CALL	PRINT
	DEFB	'.',0
;
PMIBMP:	LD	HL,(RRNO)	; Get last record read
	INC	HL		; Bump by one
	LD	DE,(ENDF)	; Check for end
	INC	DE
	AND	A
	SBC	HL,DE
	JP	NC,PMIDON	; Finished
	LD	HL,(RRNO)
	INC	HL
	JP	PMILP		; And process next one
;
PMIDON:	DEC	IX		; Set to number of records in new file
	LD	(IMNDX),IX	; Place it in index
	CALL	CLOSE		; Close both files
	CALL	CLOSE2
	CALL	PRINT
	DEFB	CR,LF,'done',CR,LF,CR,LF
	DEFB	'Xferring MESSAGES.BAK to MESSAGES.BBS...'
	DEFB	CR,LF,0
	LD	IX,0		; Clear counter
	LD	HL,(IMNDX)	; Get number of records
	LD	(CURREC),HL	; Set current record
	LD	HL,MESWRK	; MESSAGES.BBS
	CALL	OPEN2		; Open new messages file (stays open)
	LD	HL,MSGLEN
	LD	(RRSZ2),HL
;
PMSLOP:	LD	HL,MSGWRK	; MSGINDEX.BBS
	CALL	OPEN		; Open new index
	LD	HL,MNDXLEN	; Set size
	LD	(RRSZ),HL
	LD	HL,(CURREC)	; Get this record number
	CALL	GET
	LD	A,(MBLKF)
	LD	(BLOCKS),A	; Number of blocks
	LD	HL,(MSTRF)
	LD	(STRT),HL	; Starting at this record number
	LD	(MSTRF),IX	; New start record
	LD	HL,(CURREC)
	CALL	PUT		; Save it
	CALL	CLOSE		; Done with index for now
	LD	HL,MESSA2
	CALL	OPEN
	LD	HL,MSGLEN
	LD	(RRSZ),HL
	LD	A,(BLOCKS)
	LD	B,A		; Set counter to number of blocks
;
PMSLP1:	PUSH	BC		; Save counter
	LD	HL,(STRT)	; Get record number to read
	CALL	GET		; Get block
	LD	HL,(STRT)	; Get record number and....
	INC	HL		; Bump it then....
	LD	(STRT),HL	; Save it
	PUSH	IX		; New record number
	POP	HL		; To hl
	INC	IX		; Point to next record to write
	CALL	PUT2		; Write record
	POP	BC		; Restore counter
	DJNZ	PMSLP1		; Do til done with this message
	CALL	CLOSE		; Finished with old messages file for now
	CALL	PRINT
	DEFB	'.',0
	LD	HL,(CURREC)	; See if at end of new index yet
	DEC	HL
	LD	A,H
	CP	0FFH
	JP	Z,PMSDON	; Yes, so quit
	LD	(CURREC),HL	; No so update record pointer and...
	JP	PMSLOP		; Do it all again
;...
;
PMSDON:	LD	(IMRNM),IX	; Set next message record number to index
	CALL	CLOSE2		; MSGINDEX.BBS from PMIDON
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'done',CR,LF,CR,LF
	DEFB	'Updating INDEX.BBS...',0
;
; Update index file and save old index to record #2
;
	CALL	IOPEN
	CALL	GET
	LD	HL,1		; Also move it to record 2 for safety
	CALL	PUT
	LD	HL,IDATE
	LD	DE,IDATEF
	LD	BC,NDXLEN
	LDIR			; Move new index info to buffer
	LD	HL,0
	CALL	PUT
	CALL	CLOSE
	CALL	PRINT
	DEFB	'done'
	DEFB	CR,LF,CR,LF
	DEFB	'   Old INDEX info now in second record of ',CR,LF
	DEFB	'   INDEX.BBS and in INDEX.BAK for safety.'
	DEFB	CR,LF,0
	CALL	MOPEN
	LD	HL,(IMNDX)
	LD	(RRNO),HL
	CALL	CLOSE
;
	 IF	NOT SAVBAK
	LD	HL,NDXWRK	; INDEX.BAK
	CALL	BFCB		; Move name to FCB area
	LD	DE,FCB		; Then kill that file, if present
	CALL	KILBDOS
	LD	HL,MESSA2	; MESSAGES.BAK
	CALL	BFCB		; Move name to FCB area
	LD	DE,FCB		; Then kill that file, if present
	CALL	KILBDOS
	LD	HL,MSGIN2	; MSGINDEX.BAK
	CALL	BFCB		; Move name to FCB area
	LD	DE,FCB		; Then kill that file, if present
	CALL	KILBDOS
	 ENDIF			; NOT SAVBAK
;
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'Number of current messages.... ',0
	LD	HL,(RRNO)
	INC	HL		; Compensate for 1st message at record 0
	CALL	PB2ASC
	CALL	PRINT
	DEFB	CR,LF,CR,LF,0
	JP	SYS1		; Now renumber the messages
;.....
;
PERR:	CALL	PRINT
	DEFB	' -- Fatal error....',0
	JP	EXIT
;.....
;
SYSREAD:LD	A,0C3H		; Patch error exit to avoid chain to bye
	LD	HL,SYSEX1
	LD	(ERROR),A	; Load error exit with jump to...
	LD	(ERROR+1),HL	; Address of soft return
	CALL	@PRNT
	DEFB	CR,LF,CR,LF,0
	LD	HL,COMMENTS
	CALL	OPEN
	LD	HL,64
	LD	(RRSZ),HL	; Record size
	LD	HL,0
	CALL	GET		; Get next record number
	LD	HL,(RNDBUF)	; Stored in record # 0
	LD	A,H
	OR	A
	JR	NZ,GOTREC
	LD	A,L
	CP	2		; If next record =< 1 then none in file
	JR	NC,GOTREC
	CALL	@PRNT
	DEFB	CR,LF,CR,LF
	DEFB	'No records found... next record number = 1'
	DEFB	CR,LF,0
	JP	SYSEXIT
;.....
;
GOTREC:	DEC	HL		; Records = 1 less than next number
	PUSH	HL
	POP	BC		; Put number of records in counter
	LD	HL,0		; Starting record number
	LD	(RRNO),HL
;
RECLOP:	PUSH	BC		; Save counter
	LD	HL,(RRNO)
	INC	HL		; Set to next record
	CALL	GET		; Get next record
	LD	HL,RNDBUF	; Point to text
	LD	B,64		; Length of text line
	CALL	@PRNTL		; Print line
	CALL	@PRNT
	DEFB	CR,LF,0		; Carriage return to be neat
	POP	BC		; Get counter
	DEC	BC		; Less one record
	LD	A,B
	OR	C
	JP	Z,RECDON	; 0=no more
	JR	RECLOP		; >0, do more
;
RECDON:	CALL	CLOSE
	CALL	@PRNT
	DEFB	'Finished...',0
;
SYSEXIT:CALL	@PRNT
	DEFB	CR,LF,CR,LF
	DEFB	'Erase old comments? ',0
;
EXWT:	CALL	GETCH
	JR	Z,EXWT
	CALL	CAPS
	CP	'Y'
	JR	NZ,SYSEX1
	CALL	ECHO
	CALL	@PRNT
	DEFB	CR,LF
	DEFB	'Erasing old comments file...',0
	LD	HL,COMMENTS	; Initialize pointer to COMMENTS"
	CALL	BFCB
	LD	DE,FCB		; Kill CALLERS.BAK if there
	CALL	KILBDOS
;
SYSEX1:	LD	A,0C3H		; Patch error exit to avoid chain to BYE
	LD	HL,EXIT
	LD	(ERROR),A	; Load error exit with jump to...
	LD	(ERROR+1),HL	; Address of soft return
	CALL	@PRNT
	DEFB	'Done',CR,LF,0
	JP	SYS1
;
; Subroutines to handle user, index, and message files
;
UOPEN:	LD	HL,USERS
	CALL	OPEN		; Get user info to memory
	LD	HL,USRLEN	; Length of record
	LD	(RRSZ),HL
	RET
;.....
;
IOPEN:	LD	HL,INDEX	; Point to index name
	CALL	OPEN		; Open file
	LD	HL,NDXLEN	; Length of record
	LD	(RRSZ),HL	; Set into buffer
	LD	HL,0		; Set record number
	RET
;.....
;
MOPEN:	LD	HL,MSGINDEX	; Point to index name
	CALL	OPEN		; Open file
	LD	HL,MNDXLEN	; Length of record
	LD	(RRSZ),HL	; Set into buffer
	RET
;.....
;
; This routine will display the contents of the area access bits.
; This code uses the Z80 BIT TEST function.  In order to save code and
; eliminate a loop to test each bit the code is set to be self-modifying.
; The basic structure is to add a series of constant values to the basic
; BIT 0,B code to create a BIT x,B; and BIT x,C instruction.  The access
; to each area is stored in the ACCTBL table.  If a table entry is 0
; the user does not have access to the area, if the table value is a 1
; the user has access, and if the table entry is a -1, the Sysop has
; prevented the user from ever having access.  Setting the value to a -1
; is the ONLY way to keep the user from accessing a area, as the Access
; bump logic within HBBS will set a 0 access to a 1 access if the user's
; access level is >= the minimum required to access a area, unless the
; Sysop has blocked access.  DO NOT CHANGE THIS CODE or YOU MAY HAVE A
; DISASTER on your HANDS.
;
	 IF	(NMAREAS GT 1)
DACC:	LD	HL,ACCTBL	; Get address of access table into 'HL'
	XOR	A		; Clear 'A'
	LD	(HL),A		; Store in first byte of the table
	PUSH	HL
	PUSH	HL
	INC	HL
	EX	DE,HL
	POP	HL
	LD	BC,9
	LDIR
	POP	HL
	LD	D,1
	LD	(HL),D
	INC	HL
	LD	(HL),D
	INC	HL
	LD	IY,MAILTBL
	LD	A,(UFACCF)
	LD	B,A
	LD	A,(UFACCF+1)
	LD	C,A
	LD	A,40H
	LD	D,8
;
DACC1:	PUSH	AF
	LD	(DACC2+1),A
	INC	A
	LD	(DACC3+1),A
;
DACC2	EQU	$
;
	BIT	0,B
	JR	Z,DACC3
	LD	(HL),-1
	JR	DACC4
;
DACC3	EQU	$
;
	BIT	0,C
	JR	Z,DACC4
	LD	(HL),1
;
DACC4:	INC	HL
	INC	IY
	POP	AF
	ADD	A,08H
	PUSH	AF
	DEC	D
	JR	Z,DACC5
	POP	AF
	JR	DACC1
;
DACC5:	POP	AF
	LD	IX,ACCTBL+1
	LD	B,NMAREAS-1
;
DACC6:	INC	IX
	LD	A,(IX+00H)	; '(IX+00H)' has the encoded value
	OR	A
	JR	Z,DACC8
	CP	1
	JR	Z,DACC7
	LD	A,'B'
	JR	DACC9
;
DACC7:	LD	A,'Y'
	JR	DACC9
;
DACC8:	LD	A,'N'
;
DACC9:	LD	(DACC10+3),A
	PUSH	BC
	PUSH	IX
	CALL	@PRNT
;
DACC10:	DEFB	'    ',0
	POP	IX
	POP	BC
	DJNZ	DACC6
	RET
;.....
;
DAREA:	CALL	PRINT
	DEFB	CR,LF,CR,LF,'Your areas are:',CR,LF,CR,LF,0
;
DAREA2:	LD	HL,ANAME1
	LD	A,1
	LD	BC,11
	PUSH	AF
	PUSH	BC
	PUSH	HL
;
DLOOP:	POP	HL
	POP	BC
	POP	AF
	ADD	HL,BC
	INC	A
	PUSH	AF
	PUSH	BC
	PUSH	HL
	CP	NMAREAS+1
	JR	NC,DDONE
	LD	H,0
	LD	L,A
	CALL	PB2ASC
	CALL	PRINT
	DEFB	'. ',0
	POP	HL
	POP	BC
	PUSH	BC
	PUSH	HL
	CALL	PRINTL
	CALL	PRINT
	DEFB	CR,LF,0
	JR	DLOOP
;
DDONE:	POP	HL
	POP	BC
	POP	AF
	RET
	 ENDIF			; (MAREAS GT 1)
;.....
;
;-----------------------------------------------------------------------
;
; KILBDOS presets C reg for kill
; RENBOS presets C reg for rename
; BDOS CALL to save IX and IY
;
KILBDOS:LD	C,DELET		; Delete the file
	JP	SPBDOS
;.....
;
RENBDOS:LD	C,RENAME
	JP	SPBDOS
;.....
;
EATCHR:	LD	C,CONST		; Check console status
	CALL	SPBDOS
	OR	A
	RET	Z		; No characters, exit
;
	LD	C,RDCON		; Get the character
	CALL	SPBDOS
	CP	' '		; Non-printing character?
	JR	C,EATCH1	; If yes, ignore and exit
	CALL	PRINT		; Else remove from the display
	DEFB	BS,' ',BS,0
;
EATCH1:	XOR	A		; Ignore this character
	JR	EATCHR		; See if any more characters
;.....
;
;-----------------------------------------------------------------------
;
;  SUBROUTINE:	HASH
;	PURPOSE:  Calculate position in USERS.BBS to start search
;	INPUT:	  A =first character of last name
;	OUTPUT:   HL=position in USERS.BBS to begin search
;	USES:	  A,DE,HL
;
HASH:	SUB	'A'		; convert to binary
	ADD	A,A		; Double it
	LD	HL,HSHTBL	; Point to start of table
	LD	E,A		; Calculate position in table
	LD	D,0
	ADD	HL,DE
	LD	A,(HL)		; Get starting positionn in HL
	INC	HL
	LD	H,(HL)
	LD	L,A
	RET
;.....
;
;-----------------------------------------------------------------------
;
; Used in renumbering messges to match new list with old "highest read"
;
SEARCH:	XOR	A		; Clear pass flag
	LD	(PFLG),A
	LD	A,B		; Test for
	OR	C		; Zero and
	RET	Z		; Return if so
;
SRCH1:	LD	A,(IY+1)	; Compare to current number
	CP	B
	JR	C,SRCH3		; If less increment and check again
	JR	Z,SRCH2		; Not dead yet
	JP	PASTIT		; Oops, went past
;...
;
SRCH2:	LD	A,(IY)		; Now MSP byte
	CP	C
	JR	Z,FOUND		; Found it
	JR	NC,PASTIT	; Oops, past it
;
SRCH3:	INC	IY		; Point to
	INC	IY		; Next
	INC	IY		; Entry
	INC	IY		; In array
	LD	A,1		; Set pass flag
	LD	(PFLG),A
	JR	SRCH1		; And try again
;.....
;
PASTIT:	LD	A,(PFLG)	; First pass?
	OR	A		; If so, current number
	JR	Z,LTHAN		; Is less than new #1
	DEC	IY		; Back up
	DEC	IY		; One record
	DEC	IY		; In array
	DEC	IY		; And finish in common code
;
FOUND:	LD	B,(IY+3)	; Get the new value
	LD	C,(IY+2)
	RET			; And return
;.....
;
LTHAN:	LD	BC,1		; Set as low as possible
	RET			; And return
;.....
;
; Shell-Metzner sort
;
SMSORT:	LD	HL,(STARR)	; Get start address
	PUSH	HL		; Save
	LD	HL,(RLEN)	; Get length
	PUSH	HL		; It too
;
DIV:	LD	HL,(NREC2)	; NREC2=NREC2/2
	LD	DE,2
	CALL	DIV16
	LD	(NREC2),HL	; Save new NREC2
	LD	A,L
	OR	H		; Check if done
	JR	NZ,NDON
	POP	BC		; Finished
	POP	DE		; So return
	RET
;.....
;
; Set RLEN = NREC1-NREC2
;
NDON:	EX	DE,HL		; NREC2 to DE
	LD	HL,(NREC1)
	LD	A,L
	SUB	E
	LD	L,A
	LD	A,H
	SBC	A,D
	LD	H,A
	LD	(RLEN),HL
	LD	HL,1		; Set and save I=J=1
	LD	(STARR),HL
	LD	(I1),HL
;
; Calculate and save address offset (NREC2*I1)
;
	DEC	L
	POP	BC		; Length of string = I1
	PUSH	BC		; Put it back
;
LP1:	ADD	HL,DE
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,LP1
	LD	(ML1),HL
	EX	DE,HL		; Calc & save D(J), D(I), D(I+M)
	POP	BC
	POP	HL
	PUSH	HL
	PUSH	BC
;
LP2:	LD	(DJ1),HL
	LD	(DI1),HL
	EX	DE,HL
	ADD	HL,DE
	EX	DE,HL		; HL has D(I), DE has D(I+M)
;
; Compare strings and switch
;
CP1:	POP	BC		; Get length of one string in BC
	PUSH	BC
	PUSH	HL		; Save pointers,
	PUSH	DE		; In case we need to swap
	LD	B,C		; Only 10 chars, use B reg only
;
LP3:	LD	A,(DE)		; Compare each byte
	SUB	(HL)
	JR	NZ,NEQ
	INC	HL
	INC	DE
	DJNZ	LP3
	POP	DE		; Stack housekeeping
	POP	HL
	JP	NSW		; If done, don't switch
;
NEQ:	POP	DE		; If we're going to swap,
	POP	HL		; We need these
	JP	NC,NSW		; If D(I) < D(I+M), don't switch
	LD	B,10		; 10 bytes to move
;
SW:	LD	C,(HL)
	LD	A,(DE)
	LD	(HL),A
	LD	A,C
	LD	(DE),A
	INC	HL
	INC	DE
	DJNZ	SW
;
; Strings switched, check if I1-NREC2 < 1
;
	LD	HL,(NREC2)
	LD	A,H
	CPL
	LD	D,A
	LD	A,L
	CPL
	LD	E,A
	LD	HL,(I1)
	ADD	HL,DE		; If I1-NREC2 < 1, then
	JP	NC,NSW		; No switch
;
; Calculate new D(I), D(I+M)
;
	INC	HL		; Save	new I1=I1-M
	LD	(I1),HL
	LD	HL,(DI1)	; Old D(I) = new D(I+M)
	EX	DE,HL
	LD	HL,(ML1)	; Address offset
	LD	A,E		; New D(I) = old D(I)-offset
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
	LD	(DI1),HL	; Save new D(I)
	JP	CP1		; Goto compare strings
;
; Check for J > K
;
NSW:	LD	HL,(STARR)
	INC	HL		; Save new J = old J+1
	LD	(STARR),HL
	LD	(I1),HL
	EX	DE,HL
	LD	HL,(RLEN)
	LD	A,L
	SUB	E
	LD	A,H
	SBC	A,D
	JP	C,DIV		; If J>K, go to beginning and
				;   divide NREC2
; Calculate new D(J), D(I)
;
	LD	HL,(DJ1)
	POP	DE
	PUSH	DE
	ADD	HL,DE		; New D(J) = old D(J+1)
	EX	DE,HL
	LD	HL,(ML1)
	EX	DE,HL
	JP	LP2
;.....
;
;-----------------------------------------------------------------------
;
; Data area
;
DATA	EQU	$
;
TOALL:	DEFB	'ALL',0
TRECNO:	DEFW	0
ENDF:	DEFW	2	; Temp rec no. storage
DELE:	DEFW	2	; Address of start of delete array
HSHREC:	DEFW	0
STRT:	DEFW	0
CURREC:	DEFW	0
UCOUNT:	DEFW	0
DLEVEL:	DEFB	0
BLOCKS:	DEFB	0
LINES:	DEFB	0
ACCTMP:	DEFB	0
ACCTBL:	DEFS	10
MTOTMP:	DEFS	30
SAREA:	DEFS	1
CF:	DEFB	0		; Flag for the change area routine
KF:	DEFB	0		; Flag for the kill routine
UF:	DEFB	0		; Flag for the un-delete routine
IYHOLD:	DEFW	0		; Hold area used in un-delete routine
IYEND:	DEFW	0		; End of mailtable (in maint)
SHDEL:	DEFB	0		; Flag to show deleted msg question
DELFLG:	DEFB	0		; Flag that message is delete
PFLG:	DEFB	0		; Pass number flag for renumber routine
NEWAREA:DEFB	0		; Area to store newly-selected area
DELLEV:	DEFB	0
USERS2:	DEFB	'USERS.BAK',0
MSGIN2:	DEFB	'MSGINDEX.BAK',0
MESSA2:	DEFB	'MESSAGES.BAK',0
CALRS2:	DEFB	'CALLERS.BAK',0
USRWRK:	DEFB	'USERS.BBS',0
MSGWRK:	DEFB	'MSGINDEX.BBS',0
MESWRK:	DEFB	'MESSAGES.BBS',0
CALWRK:	DEFB	'CALLERS.   ',0
NDXWRK:	DEFB	'INDEX.BAK',0
;
RENI1:	DEFB	0,'INDEX   BBS',0,0,0,0
	DEFB	0,'INDEX   BAK',0,0,0,0
;
RENU1:	DEFB	0,'USERS   BBS',0,0,0,0
	DEFB	0,'USERS   BAK',0,0,0,0
;
RENM1:	DEFB	0,'MESSAGESBBS',0,0,0,0
	DEFB	0,'MESSAGESBAK',0,0,0,0
;
RENX1:	DEFB	0,'MSGINDEXBBS',0,0,0,0
	DEFB	0,'MSGINDEXBAK',0,0,0,0
;
RENC1:	DEFB	0,'CALLERS    ',0,0,0,0
	DEFB	0,'CALLERS BAK',0,0,0,0
;
RENC2:	DEFB	0,'CALLERS BAK',0,0,0,0
	DEFB	0,'CALLERS    ',0,0,0,0
;.....
;
; The following locations are used by the user sort routine
;
NREC1:	DEFW	0		; Number of records
NREC2:	DEFW	0		; Number of records again
RLEN:	DEFW	10		; Length of one record
STARR:	DEFW	0		; Starting address of user array
I1:	DEFW	0		; Temporary pointer
ML1:	DEFW	0		; Temporary pointer
DJ1:	DEFW	0		; Temporary pointer
DI1:	DEFW	0		; Temporary pointer
ENDARR:	DEFW	0		; Ending address of user array
;
; Stack area
;
BSTACK	EQU	$		; Bottom of stack for sort routines
;
	DEFS	512		; Big stack for sort routines
;
STACK:	DEFW	0

CCPSTK:	DEFW	0		; Stack storage
;
ENDATA	EQU	$-DATA
;
MSG:	DEFW	0		; Message entry storage
MSGARR:	DEFW	0		; Storage for message pointers
HBSEND:	DEFS	0
;
	END