; HMNT.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)
;
;-----------------------------------------------------------------------
;
; 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 message 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 message 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	'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
;
;-----------------------------------------------------------------------
;
SYS1:	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Resetting user areas',CR,LF,0
	JP	UPD25
;.....
;
SYS2:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'        2: Compress callers file',0
	JP	PCALRS
;.....
;
SYS3:	CALL	PRINT
	DEFB	CR,LF
	DEFB	'        6: Pack message base',0
	JP	PACK
;.....
;
SYS4:	CALL	PRINT
	DEFB	'        8: Renumber messages',0
	JP	RENUM
;.....
;
SYS5:	CALL	PRINT
	DEFB	'        9: Update USERS file',0
	JP	RHASH
;.....
;
SYS6:	JP	EXIT		; All finished
;.....
;
EXIT:	CALL	PRINT
	DEFB	CR,LF,0
	LD	HL,(CCPSTK)
	LD	SP,HL
	RET			; Return to CCP stack
;.....
;
;-----------------------------------------------------------------------
;		      Deleting these users:
;
; USER.BBS and MSGINDEX.BBS 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 or more.)
;
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
	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
	CALL	PRINT
	DEFB	'.',0
	JR	UPDA1		; Keep going until done
;
UPDA2:	CALL	PRINT
	DEFB	CR,LF,'Done',CR,LF,CR,LF
	DEFB	'Deleting these users: ',CR,LF,'  ',0
	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
	JP	Z,UPD254	; None, so quit
	CALL	MOPEN
	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?
	JP	Z,UPD253	; Yes
	CALL	GET
	LD	DE,(MSGARR)	; Get start of array
	PUSH	DE		; Save it
;
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
	POP	DE
	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 pointer and see if deletion needed
	JR	DELOP
;
DELOP1:	POP	DE		; Unjunk stack
	LD	A,1
	LD	(MREAD),A	; Show msg "was read", for auto/delete
	LD	HL,(RRNO)
	CALL	PUT
	LD	HL,(RRNO)
	LD	(RRNO2),HL	; Save the message record
	CALL	CLOSE
;
; Go update receivers mail flag
;
MF1:	LD	HL,MTOF		; Save the receiver's name away
	LD	DE,MTOTMP
	LD	BC,NAMLEN
	LDIR
	CALL	UOPEN
	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,MF5		; 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,MF5		; Not valid, so ignore
	CP	'Z'+1
	JP	NC,MF5		; Not valid, so ignore
	CALL	HASH
	LD	(HSHREC),HL
	LD	HL,(HSHREC)
;
; We now have the beginning hashed record for this user probe
;
MF4:	CALL	GET
	LD	A,(AVAILF)	; See if active
	OR	A
	JR	Z,MF5		; Not an active record, so no user
	LD	HL,UNAMEF	; See if to user
	LD	DE,MTOTMP
	LD	B,NAMLEN
	CALL	MATCH
	OR	A
	JR	Z,MF6		; Match
	XOR	A		; Clear the carry flag
	LD	HL,(RRNO)
	INC	HL		; Next record number
	EX	DE,HL
	LD	HL,(HSHREC)	; Have we checked all of them
	SBC	HL,DE
	JR	Z,MF5		; So there's no user here
	LD	HL,MAXU
	XOR	A
	SBC	HL,DE
	EX	DE,HL
	JR	NC,MF4
	LD	HL,0		; Load up first record in file
	JR	MF4		; No, keep going
;
MF5:	CALL	CLOSE		; Close
	JR	MF7
;
MF6:	LD	A,(MAILF)
	OR	A
	JR	Z,MF5
	DEC	A
	LD	(MAILF),A
	LD	HL,(RRNO)	; Get record number
	CALL	PUT
	CALL	CLOSE
;
MF7:	LD	A,(DELMSG)
	INC	A
	LD	(DELMSG),A	; Bump deleted messages by one
	CALL	MOPEN
	LD	HL,(RRNO2)
	LD	(RRNO),HL	; Restore the message record number
	JP	SRTLP2
;.....
;
UPD253:	CALL	CLOSE
;
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		; Rewrite the index file
	CALL	PUT
	CALL	CLOSE
;
; Now write the purge info to COMMENTS so the sysop will know when and
; how many users and messages were deleted.
;
	LD	HL,DATE
	LD	DE,AUTOP0
	LD	BC,8
	LDIR			; Move date into place
	LD	HL,TIME
	LD	DE,AUTOP1
	LD	BC,5
	LDIR			; Move time into place
	LD	A,(DELUSR)
	CALL	BIN2ASC		; Convert binary to ASCII
	LD	(AUTOP2),A	; MSN was in (A)
	LD	A,B		; LSN was in (B)
	LD	(AUTOP2+1),A	; Deleted users in place
	LD	A,(DELMSG)
	CALL	BIN2ASC
	LD	(AUTOP3),A
	LD	A,B
	LD	(AUTOP3+1),A	; Deleted messages in place
;
UPDNOT:	LD	HL,COMMENTS
	CALL	SPOPEN		; Open comments file
	LD	HL,64		; Record size
	LD	(RRSZ),HL
	LD	HL,0
	CALL	GET		; Get record 0
	LD	HL,(RNDBUF)
	PUSH	HL		; Save next record to write to
	INC	HL
	INC	HL		; We will write two records
	LD	(RNDBUF),HL
	LD	HL,0
	CALL	PUT		; So next guy starts at correct record
	LD	DE,RNDBUF
;
CLMSG	EQU	$+1
;
	LD	HL,AUTOP0
	LD	BC,64
	LDIR			; Put data into place
	POP	HL		; Original open record
	PUSH	HL		; But save it for next record
	CALL	PUT		; One record written
	LD	A,0
	LD	HL,RNDBUF
	LD	B,64
;
LOGUT1:	LD	(HL),A
	INC	HL
	DJNZ	LOGUT1		; Zero the buffer
	LD	DE,RNDBUF
	LD	HL,MSGBRK
	LD	BC,15
	LDIR
	POP	HL		; Get original record back
	INC	HL		; Point at next record
	CALL	PUT		; And write it
	CALL	CLOSE		; All done
	JP	SYS2
;.....
;		      end of user deletions
;-----------------------------------------------------------------------
;
; Compress the caller's file (option 2)
;
PCALRS:	CALL	PRINT
	DEFB	CR,LF,0
	LD	HL,CALWRK	; CALLERS file
	CALL	OPEN
	CP	0FFH		; Did it exist?
	JR	NZ,PCAL1
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'CALLERS file not found',CR,LF,0
	JP	SYS3		; 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	SYS3		; Back to the menu
;...
;
PCAL2:	CALL	PRINT
	DEFB	CR,LF,'Xferring CALLERS.BAK to CALLERS...',0
	LD	HL,CALRS2	; CALLERS.BAK
	CALL	OPEN
	LD	HL,CALWRK	; CALLERS file
	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',CR,LF,0
	RET
;.....
;
SMCALR:	CALL	CLOSE		; Close everthing
	CALL	CLOSE2		; Ditto
	LD	HL,CALWRK	; Initialize pointer to CALLERS file
	CALL	BFCB
	LD	DE,FCB		; Kill CALLERS if there
	CALL	KILBDOS
	CALL	PRINT
	DEFB	CR,LF,'CALLERS file too small',CR,LF
	DEFB	'Renaming CALLERS.BAK to CALLERS...',0
	LD	DE,RENC2
	CALL	RENBDOS
	CP	0FFH
	JP	Z,PERR
	RET
;.....
;		  end of compress callers file
;-----------------------------------------------------------------------
;
; Repack the message base (option 6)
;
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	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)
;
; Check messges - see if manually deleted or already read
;
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
;
; Message has been read, see if old enough to delete
;
	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
;
; Message is old enough, so delete
;
	LD	A,0FFH		; Else delete this message
	LD	(MREAD),A
	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
;
; See if manually deleted, else has not been read
;
PACK2:	LD	A,(MREAD)
	CP	0FFH		; Deleted?
	JR	NZ,PACK3	; If not, was not read yet, exit
;
; Was manually deleted, increment the "to be deleted" count
;
	LD	HL,(RDELTD)	; Increment "already deleted" counter
	INC	HL
	LD	(RDELTD),HL
	LD	HL,(RTOTAL)	; Increment "total deleted" counter
	INC	HL
	LD	(RTOTAL),HL
;
; Have now counted those which will be deleted, check next message until
; all have been checked.
;
PACK3:	LD	HL,(RRNO)	; Get number of people left to check
	LD	A,H		; See if finished yet
	OR	L
	JR	Z,PACK4		; If finished, exit
	DEC	HL		; One less person to go
	LD	(RRNO),HL	; Store number left to check
	JP	PACK1		; Go check next one
;...
;
; Messages have all been checked, display the count
;
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
;
; Close the MSGINDEX.BBS file, see enough messages to delete this time.
;
	CALL	CLOSE
	LD	A,SKPMSG
	LD	B,A
	LD	A,(RTOTAL)
	CP	B
	JP	NC,PACK44
;
; Not enough messages to delete this time, so exit
;
	CALL	PRINT
	DEFB	CR,LF,CR,LF
	DEFB	'Not enough to delete now, will exit'
	DEFB	CR,LF,0
	JP	EXIT
;...
;
PACK44:	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
	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
;.....
;
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	; INDEX.BAK
	CALL	BFCB
	LD	DE,FCB
	CALL	KILBDOS
;
	LD	HL,MSGIN2	; MSGINDEX.BAK
	CALL	BFCB
	LD	DE,FCB
	CALL	KILBDOS
;
	LD	HL,MESSA2	; MESSAGES.BAK
	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	; INDEX.BAK
	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	; MSGINDEX.BAK
	CALL	OPEN
	LD	HL,MSGWRK	; MSGINDEX.BBS
	CALL	OPEN2
	LD	HL,MNDXLEN	; Get length of each record
	LD	(RRSZ),HL	; Into source parameter block
	LD	(RRSZ2),HL	; And destination parameter 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	; Deleted message, skip
	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
	DEFB	'done',CR,LF
	DEFB	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	; MESSAGES.BAK
	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	SYS4		; Now renumber the messages
;.....
;		 end of repack the message base
;-----------------------------------------------------------------------
;			renumber messages
;
; Renumber the messages and update the USERS.BBS highest message read
; (option 8)
;
RENUM:	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,CR,LF,0
	JP	SYS5		; Now update the users file
;.....
;		    end of mesage renumbering
;-----------------------------------------------------------------------
;			USERS file update
;
; Updates the USERS.BBS file  (option 9)
;
RHASH:	CALL	PRINT
	DEFB	CR,LF,0
	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,SYS6		; If not, return to menu
	CALL	PRINT
	DEFB	'Done',CR,LF,0
	JP	SYS6		; Finished
;.....
;
RHSH2:	LD	HL,0
	LD	(UCOUNT),HL	; Zero the user counter
	CALL	PRINT
	DEFB	CR,LF
	DEFB	'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	'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	'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,0
	JP	SYS6		; Exit, all finished
;.....
;		     end of update USERS file
;-----------------------------------------------------------------------
;
PERR:	CALL	PRINT
	DEFB	' -- Fatal error....',0
	JP	EXIT
;.....
;
; 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 a file
	JP	SPBDOS
;
RENBDOS:LD	C,RENAME	; Rename a file
	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
;.....
;
;-----------------------------------------------------------------------
;
;			    ROUTINES
;
;-----------------------------------------------------------------------
;
; The values are returned from BYE as BCD and are converted below.
;-----------------------------------------------------------------------
;
BCD2A:	LD	A,(HL)
	PUSH	AF
	RRA			; Move hi nibble to lo
	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....
;.....
;
; 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
;.....
;
; 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
;.....
;
; This routine will convert a binary number 0-99 in (A), to two ascii
; digits.  ASCII is returned in (A)=most sign. nibble, (B)=LSN.
;
BIN2ASC:CALL	BINBCD		; First convert it to packed bcd
	LD	B,A		; Save binary
	AND	0FH		; Get lsn
	ADD	A,'0'		; Make ascii
	LD	C,A		; Save it
	LD	A,B		; Get binary again
	RRA
	RRA
	RRA
	RRA
	AND	0FH
	ADD	A,'0'		; Make ascii, MSN in (A)
	LD	B,C		; LSN in (B)
	RET
;.....
;
CLKERR:	POP	IY		; Clear the stack
	CALL	CLOSE		; Close any open files
	CALL	PRINT
;
CLKMSG:	DEFB	7,'Clock error..No update performed',CR,LF,0
	LD	HL,CLKMSG
	LD	(CLMSG),HL
	JP	UPDNOT		; Tell the sysop
;.....
;
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
;.....
;
MSGBRK:	DEFB	CR,LF,'=== EOM ===',CR,LF,0
;.....
;
;-----------------------------------------------------------------------
;
; Data area
;
DATA	EQU	$
;
AUTOP0:	DEFB	'MM/DD/YY at '
AUTOP1:	DEFB	'HH:MM HBYE auto-purged '
AUTOP2:	DEFB	'nn user(s) and '
AUTOP3:	DEFB	'nn message(s)',0,0
TOALL:	DEFB	'ALL',0
DELMSG:	DEFB	0
DELUSR:	DEFB	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	0H		; Stack storage
;
ENDATA	EQU	$-DATA
;
MSG:	DEFW	0		; Message entry storage
MSGARR:	DEFW	0		; Storage for message pointers at start
HBSEND:	DEFS	0
;
	END