TITLE 'PMAINT.MAC version 5.00 October 09/90' ; Filename PMNT50.MAC ; Author Ian Cottrell ; Language Z-80 Assembler ; Last Revised Oct 09/90 ; By Ian Cottrell ; The Public Bulletin Board System ; Author: Ian Cottrell ; 44 Lindhurst Cres ; Ottawa, ON, Canada ; K2G 0T7 ; The Information Centre RCP/M ; (613) 952-2289 (300/1200/2400) ;------------------------------------------------------------------ ; PBBS represents many hours of design, coding and debugging. ; However, I do not believe in SHAREWARE. So, if you find ; PBBS of value to you and wish to pay for it in some way, ; please consider a small contribution ($50 suggested) to your ; local Cancer Society in both of our names (thus creating a ; new class of software - charityware!). Then send a little ; note telling me what you did and we will both feel good! In ; any case, please share this program with others, it is free ; and no form of remuneration may be accepted by anyone except ; its author. ; Version 1.00 - March 1st 1986 - initial public release ; Version 2.00 - April 6th 1986 ; Version 3.00 - June 15th 1986 ; Version 4.00 - November 1st 1987 ; Version 4.10 - April 15th 1988 ; Version 4.50 - April 15th 1989 ; Version 5.00 - October 9th 1990 ;------------------------------------------------------------------------------ RTC EQU 0FFH ; Allows the use of BYE's insert INCLUDE PBBSEQU.HDR ; PBBS configuration equates IF M80 ; M80 .Z80 ; Needed for M80 IF LINK80 CSEG ELSE ASEG ORG 100H ENDIF ; LINK80 ENDIF ; M80 JP START ; Jump around header and data Z3IDEN: DB 'Z3ENV' ; Z3 identifier Z3TYPE: DB 1 ; Z3 environment (external) Z3EADR: DW 0000 ; Z3 environment (address) Z3LOAD: DW 0000 ; Z3 load address ; Version name, date and levels VNAME: DB 'PMAINT ' ; Name DB 'Release v ',0 ; Status VER: DB 5 ; Version VERR: DB 00 ; Revision VERDAT: DB 90 ; Year DB 10 ; Month DB 09 ; Day ; My credit! (Turn it on or off but please leave it here!) AUTHOR: DB CR,LF,' by: Ian Cottrell',CR,LF,0 INCLUDE PBBSDB.HDR ; PBBS configuration strings, etc ; Include a BYE real time clock insert IF M80 .8080 ENDIF ; M80 INCLUDE BYERTC.INS ; 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. IF M80 .Z80 ENDIF ; M80 ;------------------------------------------------------------------------------ ; You MUST have the next section EXACTLY as it is here. RTCBUF: DB 99H,99H,99H DB 19H,85H,02H,31H CCHOUR: DB 0H CCMIN: DB 0H ; Must be in indicated formats TIME: DB 'HH:MM:SS',0 ; <== place your ASCII time string here DATE: DB 'MM/DD/YY',0 ; <== place your ASCII date string here BDATE: DS 3 ; Binary date storage (filled in by GETTIM) BTIME: DS 3 ; Binary time storage (filled in by GETTIM) ;------------------------------------------------------------------------------ ; Start of program. START: LD (CCPSTK),SP ; Save old stack LD SP,STACK ; and set up local one CALL ENDPBS ; HL=first available byte after program LD (HL),-1 ; 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 PBBSxx.MAC ADD HL,DE ; Calculate end of buffer LD (HL),0 ; Store terminator 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 LD (ERROR+1),HL ; to address of soft return XOR A LD (HRDLOG),A ; Turn hardlog off CALL PVER LD A,(PW) ; See if password wanted OR A JR Z,GOTPAS ; If first character of pw=0 then skip CALL PRINT DB CR,LF,'Password: ',0 LD B,10 XOR A ; Set to echo *, LD D,A ; no word wrap LD C,A ; and do not force upper case CALL SPINP OR A ; Set flags JP Z,0000 ; Nothing entered so quit LD DE,PW ; Match input to password LD B,10 ; Number bytes to search CALL MATCH JP NZ,0000 ; No match, so quit GOTPAS: CALL IOPEN ; Index file CALL GET ; Index record LD HL,IDATEF LD DE,IDATE LD BC,NDXLEN LDIR ; Move index to buffer CALL CLOSE ; Index file ; Get today's date and place it in index area. ; This resets the proper date if clock got screwed up. MVDATE: LD HL,IDATE ; Destination for current date LD DE,0 ; Current time not wanted CALL SAVTIM ; Get date/time and move to destination SYS1: CALL PRINT DB CR,LF,LF DB '0: Quit. 5: Rehash users file.',CR,LF DB '1: Maintain users file. 6: Comp. callers file' IF MSTATS DB ', zero Sys Usage' ENDIF DB '.',CR,LF DB '2: Maintain message file. 7: BYE hardlog on/off.',CR,LF DB '3: Maint hard-copy on/off. 8: User Update/Purge.',CR,LF DB '4: Pack message base. 9: ' IF MSTATS DB 'Display STATs & ' ENDIF DB 'Read Sysop Log.',CR,LF,0 SYSWT: CALL PRINT DB CR,LF,'Select: ',0 CALL GETCH CP '0' JR C,SYSWT CP '9'+1 JR NC,SYSWT CALL ECHO SUB '0' ; Strip ASCII bias ADD A,A ; Double it LD HL,CMDTBL ; Point to command jump table LD D,0 LD E,A ADD HL,DE ; HL now points to command jump address LD A,(HL) ; Get LSB INC HL ; Point next LD H,(HL) ; Get MSB to H LD L,A ; and LSB to L JP (HL) ; Go do it CMDTBL: DW EXIT ; Quit [0] DW MUSR ; Maintain users file [1] DW MMSG ; Maintain messages file [2] DW MHLG ; Hard copy on/off [3] DW PACK ; Pack message base [4] DW RHASH ; Rehash users file [5] DW PCALRS ; Compress callers list file [6] DW BHLG ; BYE hardlog on/off [7] DW UPD25 ; User update/purge [8] DW SYSRED ; Display stats and COMMENTS file [9] EXIT: CALL PCRLF LD C,11 ; Make sure no spurious characters waiting CALL SPBDOS ; Check console status OR A ; Anything there? JR Z,EXIT1 ; No, so restore stack and exit LD C,1 ; Else, get the character CALL SPBDOS ; and just throw it away! EXIT1: LD SP,(CCPSTK) ; Restore old stack RET ; and return to it RHASH: LD HL,USERS2 ; Location for name of user backup file LD DE,USERS ; Name of user file (from PBBSDB.HDR) CALL MOV2DT ; Move the name (up to the dot) LD (HL),'.' ; Now the dot INC HL ; Point next EX DE,HL ; Swap registers LD HL,BAKNM ; Point to 'BAK' LD BC,3 ; 3 bytes to move LDIR ; Move 'em CALL PRINT DB CR,LF,LF,'This routine will erase ',0 LD HL,USERS2 ; Point to name of user backup file CALL PRINTM ; Print it CALL PRINT DB ' if it is present.' DB CR,LF,'Continue (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JP NZ,SYS1 ; If not, abort CALL PCRLF ; Else, continue with rehash LD HL,USERS2 ; Location for name of user backup file CALL BFCB ; Now make an FCB (at FCB) from the name LD DE,FCB ; Kill backup of user file, CALL KILBDOS ; if there is one CALL PRINT DB CR,LF,'Renaming ',0 LD HL,USERS ; Point to name of user file (PBBSDB.HDR) CALL PRINTM ; Print it CALL PRINT DB ' to ',0 LD HL,USERS2 ; Point to name of user backup file CALL PRINTM ; Print it CALL PRINT DB '...',0 LD HL,USERS ; Name of users file (from PBBSDB.HDR) LD DE,RENU1 ; Point to old users file name FCB CALL BFCB1 ; Make an FCB LD HL,USERS2 ; Point to name of user backup file LD DE,RENU2 ; Point to new users file name FCB CALL BFCB1 ; Make an FCB LD DE,RENU1 ; Point to rename FCBs CALL RENBDOS ; Go rename users file to users file backup CP 0FFH ; Error? JP Z,PERR ; If so, go tell us about it CALL RHSH2 ; Else, go rehash the users file CALL PRINT DB CR,LF,'Writing new index...',CR,LF,0 LD HL,IDATE LD DE,IDATEF LD BC,NDXLEN LDIR CALL IOPEN CALL PUT ; Update index CALL CLOSE JP SYS1 RHSH2: LD HL,0 LD (UCOUNT),HL ; Zero the user counter CALL PRINT DB CR,LF,'Initializing new user file...',CR,LF,0 LD HL,RNDBUF ; First fill random buffer with nulls XOR A LD B,USRLEN HFILL: LD (HL),A INC HL DJNZ HFILL LD HL,USERS ; Open users file (name in PBBSDB.HDR) CALL OPEN2 LD HL,USRLEN LD (RRSZ2),HL LD HL,MAXU-1 ; Start at last record INC HL ; Pre-inc for HBMP LD (RRNO2),HL HWRT: CALL PUT2 ; Null out the record LD HL,(RRNO2) ; Get record DEC HL ; and drop counter by one LD A,H CP 0FFH ; See if any more JP NZ,HWRT ; Yes CALL PRINT DB 'Done...',CR,LF,LF,0 LD HL,USERS2 ; Location of name of user backup file CALL OPEN LD HL,USRLEN LD (RRSZ1),HL LD HL,0 ; Start at record zero 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 DB CR,'Reading record # ',0 POP HL PUSH HL CALL PB2ASC CALL PRINT DB ' ',0 POP HL CALL GET LD A,(ACESSF) ; See if it's a deleted or free record OR A JR NZ,LASNAM ; Nope, it's active LD HL,(RRNO1) INC HL ; Oh well, go see if there are any more EX DE,HL LD HL,MAXU-1 XOR A ; Clear carry SBC HL,DE ; Any left? EX DE,HL JR NC,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,(RRNO1) ; 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,(RRNO1) ; Get record number INC HL ; Point to next record EX DE,HL LD HL,MAXU-1 ; At end? XOR A ; Clear carry SBC HL,DE EX DE,HL JP NC,RDLOOP ; Nope, so 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 DB CR,LF,LF,'Sorting users by last name...',CR,LF,0 CALL SMSORT ; Sort users alphabetically, by last name CALL PRINT DB 'Done...',CR,LF,LF,0 LD HL,(MSGARR) ; Get start of array again LD DE,8 ; Calculate location ADD HL,DE ; of 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 (RRNO1),HL ; Save first record number READLP: CALL PRINT DB CR,'Processing record # ',0 LD HL,(RRNO1) ; Get next record number PUSH HL ; Save it for later CALL PB2ASC ; Display for all to see CALL PRINT DB ' ',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 EX DE,HL LD HL,MAXU-1 ; At end? XOR A SBC HL,DE EX DE,HL JR NC,HLOOP ; Nope, continue LD HL,0 ; Else, goto start of file 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 (RRNO1),HL ; Save next record number JP READLP ; and go around again LODDON: CALL CLOSE CALL CLOSE2 CALL PRINT DB CR,LF,LF,'Rehash completed. Updating user count...',0 LD DE,MUSRT ; Destination for current time LD HL,MUSRD ; Destination for current date CALL SAVTIM ; Get date/time and move to destination LD HL,(UCOUNT) ; Set number of users LD (IUSER),HL CALL PRINT DB CR,LF,LF DB 'Done. Please verify new file before destroying ',0 LD HL,USERS2 ; Point to name of users backup file CALL PRINTM ; Print it CALL PRINT DB '.',CR,LF,BEL,0 RET MUSR: CALL @PRNT DB CR,LF,LF,'User file last maintained: ',0 LD IX,MUSRT ; Point to last user maintenance time CALL PTIME CALL @PRNT DB ' on ',0 LD IX,MUSRD ; Point to last user maintenance date CALL FULDAT CALL @PRNT DB CR,LF,'CAUTION: Take note of old data BEFORE changing...',0 MUASK: XOR A LD (TRECNO),A ; Set starting record DEC A LD (DLEVEL),A ; Set level to all MUASK1: CALL PRINT DB CR,LF,'Enter level to display (0-15; ' DB ' for ALL; C to cancel): ',0 CALL GETCH ; Get a character CALL CAPS ; Make sure it's upper case CALL ECHO ; Show it CP CR ; Carriage return? JP Z,MUCON ; If yes, go display all levels CP 'C' ; Want to cancel? JP Z,MUDON CP '1' ; Is it a '1'? JR NZ,MUASK2 ; If not, go make sure it is within range CALL GETCH ; Else, get another character CALL ECHO ; First, print it on screen CP CR ; Then, was a character entered? LD B,A ; Save it for later LD A,1 ; Prepare for level 1 JR Z,MUASK3 ; entered, he wants level 1's LD A,B ; Else, restore the character CP '0' ; Ensure that JR C,MUASK1 ; the entered character CP '5'+1 ; is within the JR NC,MUASK1 ; correct range SUB 26H ; Make it 0AH to 0FH (10 to 15 decimal) JR MUASK3 ; and go set the display level MUASK2: CP '0' ; Is it > 0? JR C,MUASK1 ; If not, go get another CP '@' ; Else, is it < 40H? JR NC,MUASK1 ; If not, go get another SUB 30H ; Make it binary MUASK3: LD (DLEVEL),A ; and set display level MUCON: CALL PCRLF CALL EATCHR ; Gobble the CR CALL UOPEN ; Users file UPLP: PUSH HL LD C,6 LD E,0FFH CALL SPBDOS ; Any Ctrl-C aborts CP 'C'-'@' JR NZ,UPLPA CALL PRINT DB 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,(RRNO1) INC HL EX DE,HL LD HL,MAXU-1 XOR A SBC HL,DE EX DE,HL JR NC,UPLP LD HL,0 ; Load up first record in file LD A,(TRECNO) OR A JR Z,PBEND ; We looked at all of them XOR A LD (TRECNO),A JR UPLP ; No, keep going PBEND: CALL PRINT DB CR,LF,LF,'No Level ',0 LD A,(DLEVEL) ; Display level CALL PA2ASC ; Print it CALL PRINT DB ' Users found.',CR,LF,0 JP MUSR UPLP0: LD HL,DLEVEL LD A,-1 CP (HL) JR Z,UPLP1 ; Display all of them LD A,(ACESSF) ; Get user level CP (HL) JR NZ,PBNXT ; Get the next one UPLP1: CALL @PRNT DB CR,LF,'1: Name .................: ',0 LD HL,UNAMEF LD B,30 CALL @PRNTL CALL @PRNT ; Call print routine DB ' Record # (',0 ; Print leading '(' LD HL,(RRNO1) ; Get record number LD A,1 ; Get length of number LD (TRECNO),A ; Save in buffer CALL PB2ASC ; Convert and print in ASCII CALL @PRNT ; Call print routine DB ')',0 ; Print trailing ')' CALL @PRNT DB CR,LF,'2: From .................: ',0 LD HL,CITSTF LD B,20 CALL @PRNTL CALL @PRNT DB CR,LF,'3: Password .............: ',0 LD HL,PSWRDF LD B,10 CALL @PRNTL CALL @PRNT DB CR,LF,'P: Phone ................: ',0 LD HL,PHONEF LD B,12 CALL @PRNTL CALL @PRNT DB CR,LF,'4: Access ...............: ',0 LD A,(ACESSF) ; Get access level LD (ACCTMP),A ; Save it for later CALL PA2ASC ; Then print it LD B,21 ; Now print CALL PAD ; 21 spaces CALL @PRNT DB 'K: Registered .....: ',0 LD A,(FBYTEF) ; Get flag byte RRA ; Rotate registration bit into carry PUSH AF ; Save flag byte JR NC,FBN CALL @PRNT DB 'Yes',0 ; Yes, registered (not fully implemented) JR SIGONS FBN: CALL @PRNT DB 'No',0 ; No, not registered (not fully implemented) SIGONS: CALL @PRNT DB CR,LF,'5: Signons ..............: ',0 LD HL,(TMSONF) ; Get number of signons CALL PB2ASC ; and print it LD B,A ; Put number of digits printed in B LD A,27 ; Get ready to print max of 27 spaces SUB B ; Subtract number of digits already printed LD B,A ; Move count to B CALL PAD ; and print spaces CALL @PRNT DB '[more] Flag ....: ',0 POP AF ; Restore flag RRA ; Rotate [more] bit into carry PUSH AF ; Save flag again JR NC,FBN1 CALL @PRNT DB 'Off',0 ; [more] toggle is off JR LAST FBN1: CALL @PRNT DB 'On',0 ; [more] toggle is on LAST: CALL @PRNT DB CR,LF,'6: Last on ..............: ',0 LD IX,LSTONF ; Point to last on date CALL FULDAT ; Print as dd mmm yy LD B,18 ; Now print CALL PAD ; 18 spaces CALL @PRNT DB 'Expert Flag ....: ',0 POP AF ; Restore flag RRA ; Rotate expert bit into carry PUSH AF ; Save flag byte JR NC,FBN2 CALL @PRNT DB 'On',0 ; Expert flag is on JR INITDU FBN2: CALL @PRNT DB 'Off',0 ; Expert flag is off INITDU: CALL @PRNT DB CR,LF,'7: Initial du ...........: ',0 LD A,(INTARF) ; Get default DU: PUSH AF ; Save for later AND 00001111B ; Isolate drive ADD A,41H ; Convert to ASCII CALL @ECHO ; and print it POP AF ; Restore default DU: AND 11110000B ; Isolate user area RRCA ; and move to low nibble RRCA RRCA RRCA CALL PA2ASC ; Show user area LD A,':' ; Make it pretty CALL @ECHO ; with a colon LD B,23 ; Now print CALL PAD ; 23 spaces CALL @PRNT DB 'New User Flag ..: ' DB 'N/A',0 FBEND: CALL @PRNT DB CR,LF,'8: MSGs waiting .........: ',0 LD A,(MAILF) CALL PA2ASC LD B,A ; Save number of digits printed LD A,27 ; Now calculate SUB B ; the number LD B,A ; of spaces required CALL PAD ; and print 'em CALL @PRNT DB 'Hotkey Flag ....: ',0 POP AF ; Restore flag byte RRA ; Rotate hotkey bit into carry PUSH AF ; Save flag byte JR C,HOTOFF ; If hotkey not set, tell us CALL @PRNT DB 'On',0 ; Hotkey flag is on JR PNULL HOTOFF: CALL @PRNT DB 'Off',0 ; Hotkey flag is off PNULL: CALL @PRNT DB CR,LF,'9: # of nulls ...........: ',0 LD A,(NNULLF) ; Get number of nulls CALL PA2ASC ; and print it CALL @PRNT DB CR,LF,'A: Last baudrate code ...: ',0 LD A,(BDCDEF) ; Get baud rate CALL PA2ASC ; and print it CALL @PRNT DB CR,LF,'B: # of up/downloads ....: ',0 LD HL,(UPLDSF) ; Get and print CALL PB2ASC ; number of uploads LD A,'/' ; Now print CALL ECHO ; a slash LD HL,(DNLDSF) ; then the number CALL PB2ASC ; of downloads CALL @PRNT DB CR,LF,'C: Userarea map .........: ',0 LD HL,(USRMPF) CALL PMAP CALL @PRNT DB CR,LF,'D: Drive map ............: ',0 LD HL,(DRVMPF) CALL PMAP IF TCAP CALL @PRNT DB CR,LF,'E: Terminal identity code: ',0 LD A,(TCODEF) CALL PA2ASC ENDIF ; TCAP CALL @PRNT DB CR,LF,'F: Time on system .......: ',0 LD A,(TOTMEF) CALL PA2ASC CALL @PRNT DB CR,LF,'G: High message .........: ',0 LD HL,(HIMSGF) CALL PB2ASC CALL @PRNT DB CR,LF,'H: Screen width .........: ',0 LD A,(LENGF) ; Get screen width CALL PA2ASC ; and print it CALL @PRNT DB CR,LF,'I: Screen length ........: ',0 LD A,(TLINF) ; Get screen length CALL PA2ASC ; and print it COND NMFLDRS GT 1 CALL @PRNT DB CR,LF DB ' Folder Number: 2' COND NMFLDRS GT 2 DB ' 3' ENDC ; NMFLDRS GT 2 COND NMFLDRS GT 3 DB ' 4' ENDC ; NMFLDRS GT 3 COND NMFLDRS GT 4 DB ' 5' ENDC ; NMFLDRS GT 4 COND NMFLDRS GT 5 DB ' 6' ENDC ; NMFLDRS GT 5 COND NMFLDRS GT 6 DB ' 7' ENDC ; NMFLDRS GT 6 COND NMFLDRS GT 7 DB ' 8' ENDC ; NMFLDRS GT 7 COND NMFLDRS GT 8 DB ' 9 ' ENDC ; NMFLDRS GT 8 DB CR,LF,'J: Folder Access:',0 CALL DACC ; Display access codes for folders 2-9 ENDC ; NMFLDRS GT 1 CALL @PRNT DB CR,LF,' Enter code (x:) of field to alter or:' DB CR,LF,'+ (next record), - (previous record),' DB ' > (find/add user), < (quit)',0 UWT: CALL PRINT DB CR,LF,'--> Select: ',0 CALL GETCH CALL CAPS CALL ECHO CP '-' JP Z,MBPREC ; Move to next record CP '+' JP Z,BACKU ; Move to previous record CP 'P' JP Z,PHN ; Change the phone # CP '1' JR C,UWT CP 'L'+1 JR NC,UWT SUB '1' ; Strip ASCII bias & make zero relative ADD A,A ; Double it LD HL,USRTBL ; Point to user edit jump table LD D,0 LD E,A ADD HL,DE ; HL now points to command jump address LD A,(HL) ; Get LSB INC HL ; Point next LD H,(HL) ; Get MSB to H LD L,A ; and LSB to L JP (HL) ; Go do it USRTBL: DW UWT3 ; User's name (1) DW UWT4 ; City, province/state (2) DW UWT2 ; Password (3) DW UWT1 ; Access level (4) DW TMO ; Times on (5) DW LSTO ; Last date on (6) DW IDU ; Initial drive/user (7) DW MWF ; Messages waiting (8) DW NLS ; Number of nulls (9) DW UWT ; Invalid character (:) DW UWT ; Invalid character (;) DW MUDON ; Return to main menu (<) DW UWT ; Invalid character (=) DW GOTO ; Find user (>) DW UWT ; Invalid character (?) DW UWT ; Invalid character (@) DW LBD ; Last baud rate (A) DW UPL ; Number of uploads/downloads (B) DW UMP ; User map (C) DW DMP ; Drive map (D) IF TCAP DW TCD ; Terminal identifier (E) ELSE DW UWT ; Invalid character (E) ENDIF DW TCH ; Time on system (F) DW HCH ; High message pointer (G) DW TCW ; Screen width (H) DW TCL ; Screen length (I) IF NMFLDRS GT 1 DW ICH ; Folder access (J) ELSE DW UWT ; Invalid character (J) ENDIF ; NMFLDRS GT 1 DW FBT ; Flag byte (K) PMAP: PUSH HL ; Save for later LD C,H CALL P8BITS ; Do MSB (bit 15 = 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 ; Change user map UMP: CALL PRINT DB CR,LF,'- userarea map (hex) --> FEDCBA9876543210' DB CR,LF,'Enter map for userareas: ',0 XOR A ; Set for echo, LD D,A ; no word wrap LD C,A ; and do not force upper case LD B,16 ; Maximum characters allowed CALL INPUT OR A JP Z,UPLP0 CALL CMAP ; Convert ASCII (bin) to binary in HL LD (USRMPF),HL ; Store it JP UWRT ; Change drive map DMP: CALL PRINT DB CR,LF,'- drive map --------> PONMLKJIHGFEDCBA' DB CR,LF,'Enter map for drives: ',0 XOR A ; Set for echo, LD D,A ; no word wrap LD C,A ; and do not force upper case LD B,16 ; Maximum characters allowed LD B,16 CALL INPUT OR A JP Z,UPLP0 CALL CMAP LD (DRVMPF),HL ; Store result JP UWRT ; Change number of nulls NLS: CALL PRINT DB CR,LF,'Enter number of nulls (0-99): ',0 LD B,2 CALL PMINP+2 ; Input and convert in common code PUSH HL ; Save result LD DE,100 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 ; Change last baud rate LBD: CALL PRINT DB CR,LF,'Enter baud-code (0-9): ',0 LBDWT: CALL GETCH CP CR JP Z,UPLP0 ; escapes CP '0' JR C,LBDWT CP '9'+1 JR NC,LBDWT CALL ECHO SUB 30H ; Make it binary LD (BDCDEF),A JP UWRT ; Change number of uploads UPL: CALL PRINT DB CR,LF,'Enter number of uploads: ',0 CALL PMINP ; Input and convert in common code LD (UPLDSF),HL ; Save result ; Change number of downloads DNL: CALL PRINT DB CR,LF,'Enter number of downloads: ',0 CALL PMINP ; Input and convert in common code LD (DNLDSF),HL ; Store result JP UWRT ; Go and update user record PMINP: LD B,5 ; Maximum length XOR A ; Echo on LD D,A ; No word wrap LD C,A ; Do not force upper case 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 RET IF TCAP ; Change terminal code TCD: CALL PRINT DB CR,LF,'Enter terminal code (0-255): ',0 LD B,3 CALL PMINP+2 ; Input and convert in common code 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 ; Change terminal width TCW: CALL PRINT DB CR,LF,'Enter screen width (40-78): ',0 LD B,2 CALL PMINP+2 ; Input and convert in common code PUSH HL ; Save result LD DE,79 AND A SBC HL,DE POP HL ; In case okay, recover result JR NC,TCW ; 255 max LD A,L LD (LENGF),A ; Store it JP UWRT ; Change terminal length TCL: CALL PRINT DB CR,LF,'Enter screen length (16-66): ',0 LD B,2 CALL PMINP+2 ; Input and convert in common code LD A,L ; Get result CP 67 ; Too big? JR NC,TCL ; If so, go do it again LD (TLINF),A ; Else, store new screen length JP UWRT ; Change time on system TCH: CALL PRINT DB CR,LF,'Enter time on system: ',0 CALL PMINP ; Input and convert in common code LD A,L LD (TOTMEF),A ; Store result JP UWRT ; Change high message pointer HCH: CALL PRINT DB CR,LF,'Enter highest msg read: ',0 CALL PMINP ; Input and convert in common code LD (HIMSGF),HL ; Store result JP UWRT COND (NMFLDRS GT 1) ; Change folder access. ICH: CALL DFLDR CALL PRINT DB CR,LF,'Enter the folder number, to EXIT: ',0 ICH1: CALL GETCH CALL CAPS CP CR JP Z,UPLP0 CP '2' JR C,ICH1 CP 030H+(NMFLDRS+1) JR NC,ICH1 CALL ECHO SUB 030H LD (SFLDR),A CALL PRINT DB CR,LF DB 'Enter G to grant, R to remove, B to block to Exit: ',0 ICH2: CALL GETCH CALL CAPS CP CR JP Z,UPLP0 CP 'G' JR Z,ICH3 CP 'R' JR Z,ICH3 CP 'B' 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 folder 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 (folder) selected above ; (and saved in (SFLDR)). DO NOT CHANGE THIS CODE or YOU MAY HAVE A ; DISASTER on your HANDS. ICH4: LD A,(UFACCF) ; Get 1st folder access byte LD B,A ; and save it in B LD A,(UFACCF+1) ; Get 2nd folder access byte LD C,A ; and put it in C LD A,(SFLDR) ; Get desired folder number SUB 2 ; Zero now stands for folder 2 ADD A,A ; x2 ADD A,A ; x4 ADD A,A ; x8 LD D,A ; Save in D LD A,080H ; Get 'RES 0,B' instruction ADD A,D ; Make it 'RES x,B' LD (ICH6+1),A ; Store it in LD (ICH7+1),A ; correct locations INC A ; Now do 'RES x,C' LD (ICH5+3),A ; and store it in LD (ICH6+3),A ; its correct locations ADD A,03FH ; Now 'SET x,B' LD (ICH5+1),A ; Store it INC A ; And 'SET x,C' LD (ICH7+3),A ; Guess what LD A,(ICHI) ; Now get desired action (G,B or R) CP 'B' ; Is it a 'B'? JR Z,ICH5 ; If yes, go and block access CP 'R' ; Else, is it an 'R'? JR Z,ICH6 ; If yes, go remove his access JR ICH7 ; Else, go grant him access ICH5: SET 0,B ; No access to this folder RES 0,C ; Same story here JR ICH8 ; Go restore access bytes to user's record ICH6: RES 0,B ; Remove access to RES 0,C ; this folder JR ICH8 ; and go restore bytes ICH7: RES 0,B ; This will give SET 0,C ; him access ICH8: LD A,B ; Put the modified LD (UFACCF),A ; bytes back LD A,C ; into their LD (UFACCF+1),A ; proper locations JP UWRT ; Go update the user's record ENDC ; NMFLDRS GT 1 ; Edit a user's flag byte (FBYTE). FBT: CALL PRINT DB CR,LF,LF,'01: Registration Flag - set = yes' DB CR,LF,'02: [more] Flag - set = off' DB CR,LF,'03: Expert Flag - set = on' DB CR,LF,'04: Hotkey Flag - set = off' DB CR,LF,LF,'Enter the flag number, to EXIT: ',0 FBT1: CALL GETCH CP CR ; Nothing entered JP Z,UPLP0 ; so go try again CP '1' ; Check the range JR Z,FBT1A ; It's a 1, no changes needed CP '4'+1 ; Else, is it >4? JR NC,FBT1 ; Yes, go get another CALL ECHO ; Print it SUB '1' ADD A,A ; x2 ADD A,A ; x4 ADD A,A ; x8 ADD A,80H ; Calc value for 'RES x,B' LD (FBRES+1),A ; Put it in place ADD A,40H ; Now calc value for 'SET x,B' LD (FBSET+1),A ; and put it in place FBT1A: LD A,(FBYTEF) ; Get flag byte, LD B,A ; put it in B PUSH BC ; and save it for later CALL PRINT DB CR,LF DB 'Enter S to set, R to reset, to Exit: ',0 FBT2: CALL GETCH CALL CAPS CALL ECHO POP BC ; Restore the flag byte CP CR JP Z,UPLP0 CP 'S' JR Z,FBSET CP 'R' JR NZ,FBT2 FBRES: RES 0,B JR FBSET1 FBSET: SET 0,B FBSET1: LD A,B ; Get byte LD (FBYTEF),A ; and put it back into user record JP UWRT ; Go update the user's record ; Find a user (or start or end of user file) GOTO: CALL PRINT DB CR,LF,'Enter first and last names (or START or END): ',0 LD B,30 ; Maximum length allowed LD C,20H ; Force upper case XOR A ; with echo LD D,A ; and no word wrap CALL INPUT OR A JP Z,MBPREC LD (LINES),A ; Save the length LD DE,STARTM ; See if 'START' LD HL,INBUF ; Point to entered string LD B,6 CALL MATCH JP Z,GSTRT ; Is 'START', so go to head of file LD DE,ENDM ; Or 'END' LD HL,INBUF ; Point to entered string LD B,4 CALL MATCH OR A JP Z,GEND ; Got it, go to end of file CALL PRINT DB CR,LF,'Searching...',0 LD HL,INBUF ; Point to name LD A,(LINES) ; Get number of characters LD C,A ; in name LD B,0 ; into BC LD A,' ' ; Want to find a space CPIR ; Now find it JP NZ,LREQD ; Nope, go get a real name LD A,(HL) ; Else, get first char of last name CP 'A' ; Check for valid character JP C,LREQD ; Go get a real name CP 'Z'+1 JP NC,LREQD ; Go get a real name CALL HASH ; Go calc starting pos'n in USERS.PBS 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 correct user LD DE,INBUF LD A,(LINES) LD B,A CALL MATCH JP Z,UPLP0 LD HL,(RRNO1) INC HL EX DE,HL ; Prepare for safe subtract LD HL,(HSHREC) XOR A ; Clear carry SBC HL,DE JR Z,NOREC0 ; Checked all records, none free LD HL,MAXU-1 ; Get ready XOR A ; Clear carry SBC HL,DE ; Done with records? EX DE,HL ; (get record back first) JR NC,GLOOP ; No, keep going LD HL,0 ; Else, load up first record in file JR GLOOP ; and continue NOREC: CALL PRINT DB CR,BEL,'Not found... Add user to file? ',0 CALL GETCH CALL CAPS CALL ECHO CP 'Y' JR NZ,NOREC1 ; Default to NO LD HL,INBUF LD DE,UNAMEF LD BC,29 LDIR LD HL,BDATE LD DE,LSTONF LD BC,3 LDIR ; Set date LD HL,DUMFON ; Point to dummy phone number LD DE,PHONEF ; and move it LD BC,12 ; to the user LDIR ; record LD A,1 LD (AVAILF),A ; Show used record LD HL,(IUSER) INC HL ; Bump user count LD (IUSER),HL LD HL,(RRNO1) ; Display the new record JP UPLP1 ; Go display it for editing NOREC0: CALL PRINT DB CR,LF,BEL,'No available records. Rehash and try again.',0 NOREC1: LD HL,(TRECNO) JP UPLP ; Go back to closest record LREQD: CALL PRINT DB BEL,'First and Last name required!',CR,LF,0 JP GOTO GEND: LD HL,MAXU-1 ; Get start of search GEND1: CALL GET ; Get record LD A,(AVAILF) ; See if active OR A JR Z,GEND2 LD A,(DLEVEL) CP 0FFH LD HL,(RRNO1) JP Z,UPLP LD HL,DLEVEL LD A,(ACESSF) ; Get user level CP (HL) JR NZ,GEND2 ; Get the next one LD HL,(RRNO1) JP UPLP ; Get him to the first active record GEND2: LD HL,(RRNO1) DEC HL JR GEND1 GSTRT: LD HL,0 ; Get end of search (end of file) JP UPLP ; Change phone number PHN: CALL PRINT DB CR,LF,'New phone number:',CR,LF DB CR,'___-___-____<<--',CR,0 LD B,12 ; Length LD HL,PHONE ; Point to input buffer PHN1: PUSH BC ; Save counter CALL GETCH ; Get input POP BC ; Restore counter CP BS ; Backspace? JR Z,BACKUP ; If so, go do it CP '0' ; Else, ASCII zero? JR C,PHN1 ; If less, get another CP '9'+1 ; Else, ASCII nine? JR NC,PHN1 ; If more, get another LD (HL),A ; Else, put character in buffer CALL ECHO ; Print it on screen INC HL ; Advance pointer DEC B ; Decrement counter LD A,B ; Counter to [A] CP 9 ; Counter at 9? JR Z,PDASH ; If so, do dash CP 5 ; Else, counter at 5? JR Z,PDASH ; If so, do dash CP 0 ; All done? JR NZ,PHN1 ; If not, loop for another character JR PHN2 ; Else, go put it in user record BACKUP: LD A,12 ; Is counter CP B ; already at 12? JR Z, PHN1 ; If so, cannot backspace LD A,BS ; Else, get a backspace CALL ECHO ; Print it LD A,B ; Counter to [A] DEC HL ; Adjust the buffer pointer INC B ; and the counter CP 8 ; Counter at 8? JR Z,BCKUP1 ; If so, accomodate the dash CP 4 ; Else, counter at 4? JR NZ,PHN1 ; If not, loop for another character BCKUP1: DEC HL ; Adjust the buffer pointer INC B ; and the counter again LD A,BS ; Get a backspace CALL ECHO ; Print it JR PHN1 ; Loop for another character PDASH: LD A,'-' ; Get a dash CALL ECHO ; Print it on screen LD (HL),A ; Insert the dash into the buffer INC HL ; Adjust buffer pointer DEC B ; and counter JR PHN1 ; Keep going PHN2: LD HL,PHONE ; Point to input buffer LD DE,PHONEF ; and to correct location in user record LD BC,12 ; Move new phone number LDIR ; to buffer JP UWRT ; and write record ; Change password UWT2: CALL PRINT DB CR,LF,'New password: ',0 LD B,10 LD C,20H XOR A LD D,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 ; Change name UWT3: CALL PRINT DB CR,LF DB 'Last name must start with same character as current.',CR,LF DB 'New name: ',0 LD B,30 LD C,20H XOR A LD D,A CALL INPUT OR A JP Z,UPLP0 LD DE,UNAMEF LD BC,30 LDIR ; Move name to buffer JP UWRT ; and write record ; Change city and province/state UWT4: CALL PRINT DB CR,LF,'New city & province/state: ',0 LD B,20 LD C,20H XOR A LD D,A CALL INPUT OR A JP Z,UPLP0 LD DE,CITSTF LD BC,20 LDIR ; Move location to buffer JP UWRT ; and write record ; Change default drive/user IDU: CALL PRINT DB CR,LF,'Drive letter: ',0 IDU1: CALL GETCH CALL CAPS CALL ECHO CP CR JP Z,UPLP0 CP 'A' JP C,IDU CP 'P'+1 JP NC,IDU SUB 41H PUSH AF ; Save drive as number 0-F CALL PRINT DB ' -> User area: ',0 LD B,2 ; Maximum length XOR A ; Set echo, LD C,A ; do not force upper case LD D,A ; and no word wrap 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 ; Change number of messages waiting MWF: CALL PRINT DB CR,LF,LF,'Number of Mail MSGs waiting: ',0 CALL PMINP ; Input and convert in common code LD A,L ; Get new number (<256) LD (MAILF),A ; and store it JP UWRT ; Change number of logins TMO: CALL PRINT DB CR,LF,'Number of logins: ',0 CALL PMINP ; Input and convert in common code LD (TMSONF),HL ; Store new times on JP UWRT ; Change date of last login LSTO: CALL PRINT DB CR,LF,'Enter last date on as ' IF EDATE DB 'dd/mm/yy ' ELSE DB 'mm/dd/yy ' ENDIF DB '( for today''s date): ',0 LD B,8 ; Maximum characters allowed XOR A ; Set to echo, LD C,A ; do not force upper case LD D,A ; and no word wrap CALL INPUT OR A ; only entered? JR NZ,LSTO1 ; If not, continue CALL RDCLOK ; Else, get current date and time LD HL,DATE ; Point to current date string JR LSTO2 ; and go put in the user record LSTO1: CP 8 ; Entered date must be 8 characters JP C,LSTERR ; If not, error IF EDATE PUSH HL ; Save start of date string LD D,(HL) ; Get hi day INC HL ; Point next LD E,(HL) ; Get lo day INC HL ; Step over INC HL ; the '/' LD B,(HL) ; Get hi month INC HL ; Point next LD C,(HL) ; Get lo month POP HL ; Restore buffer pointer PUSH HL ; Save it again LD (HL),B ; Put hi month back INC HL ; Point next LD (HL),C ; Put lo month back INC HL ; It's the INC HL ; '/' again LD (HL),D ; Put hi day back INC HL ; Once more LD (HL),E ; Put lo day back POP HL ; Now restore pointer again ENDIF ; EDATE LD BC,8 LD DE,DATE LDIR LSTO2: CALL CDATE ; Make string binary LD HL,BDATE LD DE,LSTONF LD BC,3 LDIR JP UWRT LSTERR: CALL PRINT DB BEL,' <-- MUST be 8 characters.',0 LD HL,(RRNO1) JP UPLP ; Change user level UWT1: CALL PRINT DB CR,LF,'New level (0-',0 LD A,PSYSP ; Get sysop level CALL PA2ASC ; and print it CALL PRINT ; Now finish the line DB '): ',0 UWT1A:CALL GETCH CALL ECHO CP CR ; Carriage return? JP Z,UPLP0 ; If yes, no change CP '1' ; Is it a '1' JR NZ,UWT1B ; If not, go see if a valid number CALL GETCH ; Else, might want >9, so get another char CALL ECHO ; First, print it on screen CP CR ; Then, was a character entered? LD B,A ; Save it before jumping LD A,1 ; then prepare for level 1 JR Z,UWT1C ; Yup, he wants level 1 LD A,B ; Else, restore entered character CP '0' ; Ensure that JR C,UWT1A ; the entered character CP '5'+1 ; is within the JR NC,UWT1A ; correct range SUB 26H ; Make it 0AH to 0FH (10 to 15 decimal) JR UWT1C ; and go compare it to the old level UWT1B: CP '0' ; Is it > 0? JR C,UWT1A ; If not, start again CP '9'+1 ; Else, is it < 10? JP NC,UWT1A ; If not, start again SUB '0' ; Else, make it binary UWT1C: LD B,A ; Save level in B LD A,(ACCTMP) ; Get old level CP B ; and compare JP Z,UPLP0 ; If no change, all done this one JR C,UP ; If it increased, go see if new user LD A,B ; Restore new level OR A ; Now deleted? JR Z,U2 ; If yes, go decrement system users JR UMTND ; Else, go set correct d/u maps UP: LD A,(ACCTMP) OR A ; Was it deleted before? JR NZ,UMTND ; If not, go set correct d/u maps LD HL,IUSER ; Else, increase the INC (HL) ; number of users by one JR UMTND ; and go set correct d/u maps U2: LD HL,IUSER ; Lower the number DEC (HL) ; of users by one UMTND: LD A,B ; Get new level into A LD (ACESSF),A ; Update user record SUB 2 ; Make valid user level zero relative JR C,UWRT ; No map for less than 2 CP PSYSP-2 ; Else, setting to sysop? JR Z,UWRT ; If yes, no map for him either LD HL,USMP2 ; Else, point to start of map table RLCA ; Multiply level x 2 RLCA ; x 4 LD E,A ; Move number LD D,0 ; to DE ADD HL,DE ; HL now points to correct user map LD DE,USRMPF ; DE points to user map in user record LD BC,4 ; User map + drive map = 4 bytes LDIR ; Move 'em UWRT: LD HL,(RRNO1) ; Get correct record number CALL PUT ; Update users file LD HL,(RRNO1) JP UPLP MBPREC: LD HL,(RRNO1) ; Get record number DEC HL ; and drop it by one LD A,H ; See if any CP 0FFH ; more records JP Z,MUDON ; If not, all done CALL GET ; Else, get next record LD A,(AVAILF) ; See if active OR A JR Z,MBPREC ; If not an active record, keep going LD A,(DLEVEL) ; See if we are INC A ; getting all levels JP Z,UPLP0 ; If yes, continue LD HL,DLEVEL ; Else, see if LD A,(ACESSF) ; this user is CP (HL) ; the right level JR NZ,MBPREC ; If not, LD HL,(RRNO1) ; go DEC HL ; get the JP UPLP0 ; next one MUDON: CALL CLOSE ; USERS.PBS CALL PRINT DB CR,LF,LF,'User maintenance completed.',0 LD DE,MUSRT ; Destination for current time LD HL,MUSRD ; Destination for current date CALL SAVTIM ; Get date/time and move to destination HLGDON: LD HL,IDATE ; Move the LD DE,IDATEF ; index record LD BC,NDXLEN ; into the LDIR ; random buffer CALL IOPEN ; Index file CALL PUT ; Write new index record CALL CLOSE ; Index file JP SYS1 BACKU: LD DE,MAXU-1 BACK: INC DE ; Set for compare LD HL,(RRNO1) INC HL XOR A ; Clear carry SBC HL,DE JP NC,MBPREC ; HL>DE, so forget it LD HL,(RRNO1) 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) INC A JP Z,UPLP0 LD HL,DLEVEL LD A,(ACESSF) ; Get user level CP (HL) JR NZ,BUNXT ; Get the next one LD HL,(RRNO1) INC HL JP UPLP0 BUNXT: LD HL,(RRNO1) JP BACKU MMSG: CALL PRINT DB CR,LF,'Message file last maintained: ',0 LD IX,MMSGT ; Point to last message maintenance time CALL PTIME CALL PRINT DB ' on ',0 LD IX,MMSGD ; Point to last message maintenance date CALL FULDAT XOR A ; Clear the LD (SHDEL),A ; show deleted flag CALL PRINT DB CR,LF,LF,'Show deleted messages (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JR NZ,READM1 ; If not, don't set show deleted flag LD A,-1 ; Else, set the LD (SHDEL),A ; show deleted flag READM1: CALL PCRLF LD DE,(MSGARR) ; Point to messages table PUSH DE CALL PRINT DB CR,LF,LF,'Please wait, loading...',0 RPCNT: CALL MIOPEN ; Open message index file LD (RRNO1),HL MRDLP: LD HL,(RRNO1) CALL GET LD A,(MREAD) CP -1 ; Is it deleted? JR NZ,MRP1 ; No, add it to the list LD A,(SHDEL) ; Else, showing deleted? OR A JP Z,MBUMP ; Nope, skip to next MRP1: LD HL,MRECF ; Point to message index record number POP DE ; Get current pointer LD BC,2 LDIR ; Save message info PUSH DE ; New pointer LD C,D LD A,(007H) ; Get top of TPA DEC A ; Give us some head room SUB C JR NZ,MBUMP ; We still have room CALL PRINT DB 'Unable to display all messages',BEL,CR,LF,0 JR TPAEND ; Bail out MBUMP: LD DE,(RRNO1) ; Get record INC DE ; and up it by one LD (RRNO1),DE LD HL,(IMNDX) ; See if any more XOR A ; Clear carry flag SBC HL,DE ; Yes JP NC,MRDLP TPAEND: POP IY ; Get pointer to end of array (was DE) LD (IY),-1 LD (IY+1),-1 LD (IYEND),IY CALL PCRLF DEC IY DEC IY ; Get last message pointer LD A,-1 LD (SHDEL),A ; We now use SHDEL for direction pointer MLOP1: LD A,(IY) ; See if at end of array CP -1 JR NZ,PM01 LD A,(IY+1) CP -1 JP Z,NOMOR ; At end, so quit LD (IYHOLD),IY ; Show header of message about to be displayed. PM01: LD L,(IY) ; Set msgindex record LD H,(IY+1) LD (RRNO1),HL ; Prepare to display CALL GET CALL PCRLF1 ;------------------------------ ; Display Message Header ;------------------------------ CALL @PRNT ; Display message number DB CR,LF,LF DB 'Mesg: ',0 LD HL,(MNUMF) ; Message number CALL PB2ASC ; Display message number LD B,A ; Remaining length in B LD A,6 ; Max allowed SUB B ; Calculate pad spaces LD B,A ; in B CALL PAD ; Pad to next field ; Display message read status R0: LD A,(MREAD) ; Message read/deleted flag OR A ; Deleted? LD A,' ' ; Assume not read or deleted JR Z,R2 ; If Z, it's unread JP M,R1 ; If M, it's deleted LD A,'R' ; Else, it's read JR R2 R1: LD A,'D' ; Message is deleted R2: LD (R3+1),A ; Message status character CALL @PRNT ; Display message status R3: DB '( )',0 ; Display message security status R3A: LD B,8 ; Pad 8 spaces CALL PAD ; Pad to next field LD A,(MPUBF) ; Message public/private flag OR A ; Public? JR Z,R3C ; If yes, display public CALL @PRNT ; Else, display private DB 'Private',0 JR R4 R3C: LD B,7 ; Pad 7 spaces (public message) CALL PAD ; Pad to next field ; Display date R4: LD B,7 ; 7 spaces to date field CALL PAD ; Print spaces CALL @PRNT ; Display date DB 'Date: ',0 LD IX,MDATF ; Message date CALL FULDAT ; Display message date CALL PCRLF ; New line IF NMFLDRS GT 1 ; Display folder name CALL @PRNT ; Display folder DB 'Fldr: ',0 LD A,(MFNUMF) ; Message folder number CALL SFLDR2 ; Display folder Name CALL PAD ; Print rest of 25 chars set in SFLDR ELSE LD B,15 ; Pad 25 spaces (over folder area) CALL PAD ; Pad to next field ENDIF ; NMFLDRS GT 1 R5: LD B,6 ; 6 more spaces needed CALL PAD ; Pad to next field ; Display time CALL @PRNT ; Display time DB 'Time: ',0 LD IX,MTIMEF ; Message time CALL PTIME ; Display message time ; Display subject CALL @PRNT ; Display subject DB CR,LF DB 'Subj: ',0 LD HL,MSUBF ; Point to message subject LD B,26 ; Maximum length CALL @PRNTL ; Display original message in thread IF MSGTHD CALL PAD ; Space over to Rply field CALL @PRNT DB ' Rply: ',0 LD HL,(MREPLY) ; Get message replied to LD A,L ; Is MREPLY=0 OR H JR NZ,MPREPLY CALL @PRNT DB 'None',0 JR MNREPLY MPREPLY:CALL PB2ASC ; Print reply number MNREPLY:CALL @PRNT DB ' (',0 LD HL,(MRLNK) ; Get and display reverse link LD A,L ; Is MRLNK=0 OR H JR NZ,MPRLNK CALL @PRNT DB 'BOT',0 ; Print BOT (Beginning Of Thread) JR MNPRLNK MPRLNK: CALL PB2ASC MNPRLNK:CALL @PRNT DB '-',0 LD HL,(MFLNK) ; Get and display forward link LD A,L ; Is MFLNK=0 OR H JR NZ,MPFLNK CALL @PRNT DB 'EOT',0 ; Print EOT (End Of Thread) JR MNPFLNK MPFLNK: CALL PB2ASC MNPFLNK:CALL @PRNT DB ')',0 LD HL,(MREPLY) ; Get MREPLY LD (OLDMSG),HL ; Save for later ENDIF ; MSGTHD ; Display message sender CALL @PRNT ; Display sender DB CR,LF DB 'From: ',0 LD HL,MFROMF ; Point to sender's name LD B,30 ; Max length CALL @PRNTN ; Print in mixed case CALL PAD ; Print remainder of spaces to max+1 ; Display message receiver CALL @PRNT ; Display receiver DB ' To: ',0 LD HL,MTOF ; Point to receiver's name LD B,30 ; Max length CALL @PRNTN ; Print in mixed case LD A,(MBLKF) LD B,A PUSH BC LD HL,(MSTRF) LD (MSGREC),HL LD HL,(MRECF) ; Get this index record LD (CURREC),HL ; Save it LD A,NMFLDRS ; Moved from below! DEC A JR Z,MLOP0 LD A,-1 LD (CF),A CALL PRINT DB CR,LF,'C)hange folder, ',0 MLOP0: CALL PRINT DB 'G)oto, H)eader, N)ext, P)rev, Q)uit, R)ead,',CR,LF DB 'T)oggle [pub/priv]',0 XOR A LD (KF),A LD (UF),A LD A,(MREAD) ; Read/deleted flag INC A ; Was it deleted? JR Z,MLOP2B ; If yes, allow 'undelete' MLOP2A: CALL PRINT ; Else, he can delete it DB ', D)elete: ',0 LD A,-1 LD (KF),A JR PWAIT MLOP2B: CALL PRINT DB ', U)ndelete: ',0 LD A,-1 LD (UF),A PWAIT: CALL GETCH LD HL,MSGTBL ; Point to start of table LD BC,MSGEN-MSGTBL ; Number of entries in table to BC CP CR ; CR? JP Z,PMGO0 ; If yes, go read message CP ' ' ; Else, other control character? JR C,PWAIT ; If so, go get another one CALL CAPS ; Else, capitalize this one, CALL ECHO ; print it and CPIR ; search table for match JR NZ,PWAIT1 ; Entry not found ADD HL,BC ; Multiply pointer by 3 ADD HL,BC ADD HL,BC LD A,(HL) ; Get INC HL ; address LD H,(HL) ; into LD L,A ; HL JP (HL) ; Go do it MSGTBL: IF NMFLDRS GT 1 DB 'C' ENDIF ; NMFLDRS GT 1 DB 'DGHNPQRTU' MSGEN: DW UNDEL ; Undelete (is that a word?) [U] DW TPP ; Toggle private/public [T] DW PMGO ; Read [R] DW DONEM ; Quit [Q] DW BACKM ; Previous message [P] DW MFWD ; Next message [N] DW EDHDR ; Edit header [H] DW MGOTO ; Goto a message number [G] DW MKILL ; Delete [D] IF NMFLDRS GT 1 DW CFLDR ; Change folder [C] ENDIF ; NMFLDRS GT 1 PWAIT1: CALL PRINT DB BS,' ',BS,0 JR PWAIT MGOTO: CALL PRINT DB 'oto',LF DB CR,LF,'Message number to go to (1-',0 LD HL,(IMNXT) ; Next message number DEC HL CALL PB2ASC CALL PRINT DB '): ',0 LD B,5 XOR A ; Set echo LD C,A LD D,A CALL INPUT ; Returns 0 if nothing entered JP Z,ENDNUM ; Nothing entered so quit LD (CNVRT0+1),A ; # of characters entered LD A,(HL) CP '1' ; Less than 1? JR C,GN1 ; Yup, go tell him about it CP '9'+1 ; Greater than 9? JR C,GN3 ; Nope, go process a valid number GN1: CALL PRINT ; Else, tell him about it DB CR,LF,'Enter message number only.',CR,LF,0 JR MGOTO GN3: PUSH HL GN5: POP IX CALL CNVRT0 GN6: EX DE,HL LD HL,(IMNXT) ; Get next message number DEC HL ; Current highest message AND A ; Clear carry flag SBC HL,DE JR C,NANY ; Tell him out of range EX DE,HL ; User request back to HL LD A,L ; Test for zero OR A JR NZ,FNDRC ; If not, go find the correct record number LD A,H OR A JR NZ,FNDRC ENDNUM: JP MGOTO NANY: CALL PRINT DB CR,LF,'Not a valid message number',0 JP MGOTO FNDRC: PUSH HL ; User request - popped as DE later OR A ; Clear carry LD DE,1 SBC HL,DE ; See if user requested msg #1 LD IY,(MSGARR) ; First, point to start of array JR NZ,FNDNXT ; Not msg #1, carry on JP PM01 ; Else, go display record zero FNDNXT: CALL PRINT DB CR,LF,'Stand by...locating message...',CR,LF,LF,0 FNDRC1: LD L,(IY) ; Get record number for next message LD H,(IY+1) LD (RRNO1),HL ; Send it to record # counter LD A,L ; See if at end of array CP -1 JR NZ,FNDRC2 LD A,H CP -1 JP Z,PM01 ; At end, so display header of last message FNDRC2: CALL GET POP DE ; Restore user ask PUSH DE ; and save it again AND A ; Clear carry flag LD HL,(MNUMF) SBC HL,DE JP Z,PM01 ; That's the one, go display header JR NC,FNDRC3 ; Too big, back up one and done INC IY ; Point to next message INC IY JR FNDRC1 ; Too small, try next one FNDRC3: DEC IY ; Point to previous message DEC IY JP PM01 ; Go display header MSEND: LD IY,(IYEND) MFWD: CALL PRINT DB 'ext',0 INC IY INC IY JP MLOP1 ; Display message PMGO0: LD A,'R' ; Print an 'R' for 'Read' CALL ECHO ; when called by PMGO: CALL PRINT DB 'ead',0 CALL MOPEN1 ; Open message file at FCB2 LD HL,(MSGREC) ; Get message record back LD (RRNO2),HL POP BC ; Recover line count LD DE,(MSG) ; Point to start of buffer PMLOP2: PUSH BC ; Save counter LD HL,(RRNO2) PUSH DE ; Save buffer address CALL GET264 POP DE ; Get buffer address LD HL,RNDBUF LD BC,64 ; Move to message buffer LDIR ; DE=next buffer address LD HL,(RRNO2) INC HL ; Next line (record) LD (RRNO2),HL POP BC ; Get counter DJNZ PMLOP2 ; Done? CALL CLOSE2 CALL LIST ; List the message to screen JR Z,CL2 ; Did he try to abort? JP NZ,MLOP1 ; YUP, abort listing... CL2: PKILLA: CALL ABORT ; Check for 'Q' abort JR Z,PKL1 CALL PCRLF PKL1: JP MLOP1 ; Kill routine. MKILL: LD A,(KF) ; Is message already OR A ; deleted? JP Z,PWAIT1 ; If yes, invalid character, get another CALL PRINT ; Else, sign on DB 'elete',0 LD A,-1 ; Set read/delete flag to deleted LD (MREAD),A IF MSGTHD LD HL,(MFLNK) ; Get forward link LD (FWDMSG),HL ; Save it for later LD HL,(MRLNK) ; Get reverse link LD (REVMSG),HL ; Save it for later ENDIF ; MSGTHD LD HL,(RRNO1) ; Restore record number CALL PUT ; and write record back DMF1: CALL UOPEN1 ; Users file at FCB2 LD HL,MTOF ; Point to desired user CALL MF1 ; Get user record into memory OR A JR NZ,DMF2 ; Didn't find one LD A,(MAILF) OR A JR Z,DMF2 ; If already zero, bail out DEC A ; Else, decrement it LD (MAILF),A ; and put it back LD HL,(RRNO2) ; Get record number CALL PUT2 ; and write user record DMF2: CALL CLOSE2 ; Users file at FCB2 IF MSGTHD CALL UPDEL ; Update links for deletion ENDIF ; MSGTHD JP MLOP1 ; And go to check for next message data ; Un-delete a message and then update the index UNDEL: LD A,(UF) ; Is message OR A ; deleted? JP Z,PWAIT1 ; If not, invalid character, get another CALL PRINT ; Else, sign on DB 'ndelete',0 XOR A ; Set read/delete flag to 'read' LD (MREAD),A IF MSGTHD LD HL,(MNUMF) ; Get current message number LD (OLDMSG),HL ; Save it for later LD HL,(MFLNK) ; Get forward link LD (FWDMSG),HL ; Save it for later LD HL,(MRLNK) ; Get reverse link LD (REVMSG),HL ; Save it for later ENDIF ; MSGTHD LD HL,(RRNO1) CALL PUT IMF1: CALL UOPEN1 ; Users file at FCB2 LD HL,MTOF ; Point to desired user CALL MF1 ; Get user record into memory OR A JR NZ,IMF3 LD HL,MAILF INC (HL) LD HL,(RRNO2) ; Get record number CALL PUT2 IMF3: CALL CLOSE2 ; Users file at FCB2 IF MSGTHD CALL UPUDEL ENDIF ; MSGTHD JP MLOP1 ; Go back and redisplay message ; Subroutine: ; Go get the user record for the name at (HL) ; Returns -1 if no user found, 0 if valid user MF1: LD DE,MTOTMP ; Save the user's name LD BC,30 LDIR LD HL,MTOTMP ; Get user name LD BC,30 ; Get max number of characters LD A,' ' ; Want to find a space CPIR ; Now find it JP NZ,MF7 ; Nope, ignore it LD A,(HL) ; Get first char of last name CP 'A' ; Check for valid character JP C,MF7 ; Not valid, so ignore CP 'Z'+1 JP NC,MF7 ; Not valid, so ignore CALL HASH ; Calc starting pos'n in USERS.PBS LD (HSHREC),HL ; We now have the beginning hashed LD HL,(HSHREC) ; record for this user probe MF4: CALL GET2 ; Get record from users file LD A,(AVAILF) ; See if active OR A JR Z,MF7 ; Not an active record, so no user LD A,(ACESSF) ; See if valid CP 2 ; (0=deleted, 1=twit, 2 or greater=okay) JR C,MF5 LD HL,UNAMEF ; Name from this user record LD DE,MTOTMP ; Desired name LD B,30 ; Max length of names CALL MATCH ; See if match OR A RET Z ; Got a match, return to sender MF5: LD HL,(RRNO2) ; Else, get next user record INC HL EX DE,HL LD HL,(HSHREC) ; See if we've come all the way around SBC HL,DE JR Z,MF7 ; We have, so bail out LD HL,MAXU-1 ; See if we're at the end of the file XOR A SBC HL,DE EX DE,HL JR NC,MF4 ; More to go.. LD HL,0 ; Load up 0 record JR MF4 ; and keep going MF7: XOR A ; Didn't find anything DEC A ; .. so clear Z flag and quit RET IF MSGTHD ; Deleting or Undeleting a record in a threaded message chain requires some ; attention. If you remove a record from the thread, you must update the ; forward and reverse links of that message to reflect the new links. ; ; MSG 100 MSG 140 MSG 180 ; flink 140 flink 180 flink 220 ; rlink 80 rlink 100 rlink 140 ; ; MSG 100 MSG 140 (Deleted) MSG 180 ; flink 180 flink 220 ; rlink 80 rlink 100 ; ; As you can see, the links in messages 100 and 180 have been changed to ; reflect the deletion of message 140. ; This first section of code is responsible for UPdating forward and ; reverse links for a DELeted message UPDEL: PUSH HL ; Save all registers PUSH DE PUSH BC PUSH AF LD HL,(RRNO1) ; Restore record number CALL GET ; and get message index file record LD HL,(MREPLY) ; Get first message in thread LD DE,(MNUMF) ; Get current message number CALL SUBHL ; Subtract to compare JR NZ,UPFL ; If equal, start updating fwd links LD HL,(MFLNK) ; Else, get forward link LD A,L ; Is it zero? OR H JR Z,UPRL ; If so, bypass forward link processing LD (NEWMSG),HL ; Else, save forward link for later REPLP: CALL GETRC ; Convert msg # to record # LD HL,(RRNO1) ; Get record number PUSH HL ; Save record number CALL GET ; Get record LD HL,(NEWMSG) ; Get first message in link LD (MREPLY),HL ; Save in buffer POP HL ; Restore record number CALL PUT ; Write record LD HL,(MFLNK) ; Get next forward link LD A,L ; Is MFLNK=0? OR H JR NZ,REPLP ; If not, continue through links UPFL: LD HL,(FWDMSG) ; Get forward link LD A,L ; Is MFLNK=0 OR H JR Z,UPRL ; If so, go process reverse links CALL GETRC ; Else, convert msg # to record # LD HL,(RRNO1) ; Get record number PUSH HL ; Save record number CALL GET ; Go get record LD HL,(REVMSG) ; Get new reverse link LD (MRLNK),HL ; Replace reverse link POP HL ; Restore record number CALL PUT ; Save record UPRL: LD HL,(REVMSG) ; Get reverse link message number LD A,L ; Is MRLNK=0? OR H JP Z,DELEX ; If so, all done CALL GETRC ; Else, convert msg # to record # LD HL,(RRNO1) ; Get record number PUSH HL ; Save record number CALL GET ; Go get record LD HL,(FWDMSG) ; Get new forward link LD (MFLNK),HL ; Replace forward link POP HL ; Restore record number CALL PUT ; Save record JR DELEX ; Restore registers and exit ; This next section of code is responsible for UPdating forward and ; reverse links for an UnDELeted message. UPUDEL: PUSH HL ; Save all registers PUSH DE PUSH BC PUSH AF LD HL,(RRNO1) ; Restore record number CALL GET ; and get message index file record LD HL,(MREPLY) ; Get MREPLY LD DE,(MNUMF) ; Get current message number CALL SUBHL ; Subtract to compare JR NZ,UPUFL ; If not equal - skip processing LD HL,(MREPLY) ; Get MREPLY LD (NEWMSG),HL ; Save for later REPULP: CALL GETRC ; Convert msg # to record # LD HL,(RRNO1) ; Get record number PUSH HL ; Save record number on stack CALL GET ; Get record LD HL,(NEWMSG) ; Get forward link LD (MREPLY),HL ; Save in buffer POP HL ; Restore record number from stack CALL PUT ; Write record LD HL,(MFLNK) ; Get forward link LD A,L ; Is MFLNK=0 OR H ; If yes, we're done JR NZ,REPULP ; Continue until done UPUFL: LD HL,(FWDMSG) ; Get forward link LD A,L ; Is MFLNK=0 OR H ; If yes, nothing to update JR Z,UPURL ; Continue with MRLNK CALL GETRC ; Convert msg # to record # LD HL,(RRNO1) ; Get record number PUSH HL ; Save record number CALL GET ; Get record LD HL,(OLDMSG) ; Get message to be undeleted LD (MRLNK),HL ; Update next messages reverse link POP HL ; Restore record number CALL PUT ; Save record UPURL: LD HL,(REVMSG) ; Get reverse link LD A,L ; Is MRNLK=0 OR H ; If yes, nothing to update JR Z,DELEX ; This was a waste of time too! CALL GETRC ; Else, convert msg # to record # LD HL,(RRNO1) ; Get record number PUSH HL ; Save record number CALL GET ; Get record LD HL,(OLDMSG) ; Get message to be undeleted LD (MFLNK),HL ; Replace reverse link POP HL ; Restore record number CALL PUT ; Save record DELEX: POP AF ; Restore registers POP BC POP DE POP HL RET ENDIF ; MSGTHD ;*********************************************************************** ; SUBROUTINE: GETRC ; PURPOSE: Take a message number and return the appropriate ; message index file record number for that message. ; INPUT: HL=message number to find ; OUTPUT: (RRNO1)= message index file record number ; USES: A, DE, HL ; CALLS: GET ;*********************************************************************** GETRC: PUSH HL ; User request - popped as DE later OR A ; Clear carry LD DE,1 SBC HL,DE ; See if user requested msg #1 JR NZ,GETNXT ; If not, go find correct record LD (RRNO1),HL ; Else, set to record zero JP GETDON ; and finish GETNXT: LD HL,(IMNDX) ; Get number of records INC HL LD (RRNO1),HL ; Send it to record # counter GETRC1: LD HL,(RRNO1) ; Get record # counter DEC HL LD A,H ; See if all done CP -1 JR Z,GETDON LD (RRNO1),HL ; Else, set new record CALL GET POP DE ; Restore user request PUSH DE AND A ; Clear carry flag LD HL,(MNUMF) SBC HL,DE JR Z,GETDON JR C,GETRC2 JR GETRC1 GETRC2: LD HL,(RRNO1) INC HL LD (RRNO1),HL GETDON: POP DE ; Clear the stack RET COND (NMFLDRS GT 1) CFLDR: CALL PRINT DB 'hange folder',LF DB CR,LF,'Select a NEW folder number from the following list:' DB CR,LF,'01. ',0 LD HL,FNAME1 LD B,16 CALL PRINTL CALL PCRLF CALL DFLDR2 CALL PRINT DB 'Enter NEW folder number or : ',0 CFLDR2: CALL GETCH CALL CAPS CALL ECHO CP CR JP Z,MLOP1 CP '1' JR C,CFLDR2 CP NMFLDRS+031H JR NC,CFLDR2 SUB 030H LD (NEWFLDR),A LD A,(NEWFLDR) LD (MFNUMF),A LD HL,(RRNO1) ; Set record number CALL PUT JP MLOP1 ; Go back and redisplay message ENDC ; NMFLDRS GT 1 TPP: CALL PRINT DB 'oggle',0 LD A,(MPUBF) XOR 0FFH LD (MPUBF),A LD HL,(RRNO1) CALL PUT JP MLOP1 MLCOM1: CALL CLOSE ; Close messages file while we kill CALL MIOPEN ; Open message index file LD HL,(CURREC) ; Get pointer to message index record # LD (RRNO1),HL ; Read it CALL GET RET MOPEN1: LD HL,MSGS ; Point to filename CALL OPEN1 ; Open file using FCB2 LD HL,MSGLEN LD (RRSZ2),HL RET ; Edit message header EDHDR: CALL PRINT DB 'eader edit ',0 XOR A ; Clear sysop flag LD (SYSFLG),A CALL PRINT DB CR,LF,'Message from? ( for no change)',CR,LF,0 LD HL,MFROMF ; Point to current name LD B,30 ; Max 30 chars CALL PRINTL ; Show the user LD HL,DSHSTR ; Now finish the pretty display INC B ; Take care of zero case CALL PRINTL CALL PRINT DB '<<--',CR,0 LD C,20H ; Set for upper case LD B,30 ; Maximum characters allowed XOR A ; Echo on LD D,A ; Clear wrap flag CALL INPUT OR A JP Z,GETTO ; Carriage return only, don't change LD HL,INBUF ; Is sender LD DE,SYSSTR ; the sysop? LD B,6 CALL MATCH JR Z,FRFND ; Yes, so don't check name CALL PRINT ; Else, look him up in users file DB CR,LF,'Checking user file...',0 CALL UOPEN1 ; USERS.PBS at FCB2 LD HL,INBUF ; Point to user to check CALL MF1 ; See if he's in USERS.PBS JR Z,FRFND ; Yup, carry on CALL PRINT ; Else, tell us and get another name DB CR,'User not found, please check your spelling',CR,LF,0 LD HL,(RRNO1) ; Get current record in message index file CALL GET ; and read it into memory JP EDHDR FRFND: CALL PRINT DB ' Valid user; name accepted.',CR,LF,0 LD HL,(RRNO1) ; Get current record in message index file CALL GET ; and read it into memory LD HL,INBUF ; Now move the new name to LD DE,MFROMF ; the message index buffer LD BC,30 LDIR GETTO: CALL PRINT DB CR,LF,'Message to? ( for no change)',CR,LF,0 LD HL,MTOF ; Point to current name LD B,30 ; Max 30 chars CALL PRINTL ; Show the user LD HL,DSHSTR ; Now finish the pretty display INC B ; Take care of zero case CALL PRINTL CALL PRINT DB '<<--',CR,0 LD C,20H LD B,30 XOR A ; Echo on LD D,A ; Clear wrap flag CALL INPUT OR A JP Z,GETSUB ; No change LD HL,INBUF ; Is it to LD DE,SYSSTR ; the sysop? LD B,6 CALL MATCH JR NZ,GETTO1 ; Nope, carry on LD A,1 ; Else, set LD (SYSFLG),A ; the sysop flag LD HL,SYSOP ; Substitute LD DE,INBUF ; the sysop's LD BC,30 ; real name LDIR JR GETTO2 GETTO1: LD HL,INBUF ; Is it LD DE,ALLMSG ; to 'ALL'? LD B,10 CALL MATCH JP Z,TOFND1 ; Yup, don't bother with user check GETTO2: CALL PRINT ; Else, go check USERS.PBS DB CR,LF,'Checking user file...',0 LD HL,(RRNO1) ; Get current record in message index file CALL PUT ; and put the current info back CALL UOPEN1 ; Open users file at FCB2 LD HL,INBUF ; Point to user to check CALL MF1 ; See if he's in USERS.PBS JR Z,TOFND ; Yup, carry on CALL PRINT ; Else, tell us and get another name DB CR,'User not found, please check your spelling',CR,LF,0 LD HL,(RRNO1) ; Get current record in message index file CALL GET ; and read it into memory JP GETTO TOFND: CALL PRINT DB ' Valid user; name accepted.',CR,LF,0 LD HL,MAILF ; Point to new user's mail flag INC (HL) ; and adjust it LD HL,(RRNO2) ; Now update CALL PUT2 ; the user's record LD HL,(RRNO1) ; Get current record in message index file CALL GET ; and read it into memory TOFND1: LD HL,MTOF ; Was the previous LD DE,SYSSTR ; receiver the sysop? LD B,6 CALL MATCH JR NZ,TOFND2 ; Nope, carry on LD HL,SYSOP ; Else, substitute LD DE,MTOF ; the sysop's LD BC,30 ; real name LDIR JR TOFND3 TOFND2: LD HL,MTOF ; Was the previous LD DE,ALLMSG ; receiver 'ALL'? LD B,10 CALL MATCH JR Z,TOFND4 ; Yup, can't adjust mail flag TOFND3: LD HL,MTOF ; Else, point to previous receiver CALL MF1 ; Get his record from USERS.PBS LD HL,MAILF ; Point to his mail flag DEC (HL) ; and adjust it LD HL,(RRNO2) ; Now update the CALL PUT2 ; user's record LD HL,(RRNO1) ; Get current record in message index file CALL GET ; and read it into memory, again TOFND4: LD A,(SYSFLG) ; Is this OR A ; to 'SYSOP'? JR Z,TOFND5 ; If not, skip next LD HL,MTOF ; Else, zero LD DE,MTOF+1 ; message index LD BC,29 ; 'TO' buffer LD (HL),0 LDIR LD HL,SYSSTR ; And move LD DE, MTOF ; 'SYSOP' LD BC,5 ; to it LDIR JR GETSUB ; Now go get the subject TOFND5: LD HL,INBUF ; Move new name LD DE,MTOF ; to the message LD BC,30 ; index buffer LDIR GETSUB: CALL PCRLF CALL PRINT DB 'Subject? ( for no change)',CR,LF,0 LD HL,MSUBF ; Point to current subject LD B,26 ; Max 26 chars CALL PRINTL ; Show the subject LD HL,DSHSTR ; Now finish the pretty display INC B ; Take care of zero case CALL PRINTL CALL PRINT DB '<<--',CR,0 LD B,26 ; Maximum number of characters XOR A ; Set input flags LD D,A LD C,A CALL INPUT OR A JR Z,SAMSUB ; No change LD HL,INBUF ; Else, move the new subject LD DE,MSUBF ; to the message index buffer LD BC,26 LDIR SAMSUB: LD HL,(RRNO1) ; Set record number CALL PUT ; and write new info to file JP MLOP1 ; Go back and redisplay message ;----------------------------------------------------------------------- ; Displays messages LIST: LD A,16 LD (TLINES),A ; LD IX,(MSG) ; Point to buffer LD HL,(MSG) ; Independent check for line length LISTA: PUSH HL CALL PCRLF1 ; Start a new line POP HL XOR A LD (COLUMN),A ; Current column number LD (SPCSTR),A ; Flag to show a space has been received LD (PNTCHR),A ; Reset printing character flag ; Count the text one character at a time. If too many for the desired ; maximum line length, do a word wrap on the local display. LSTLP: LD A,(HL) ; Get the character OR A JR Z,LSTLP1 ; End of message, exit CP CR ; End of line character? JP Z,LSTNEW ; See if CR should be retained CP ' ' ; See if 01 or other non-printing JR C,LSTLP4 ; Skip any non-printing characters LSTLP1: LD A,(COLUMN) ; Increment for this character INC A LD (COLUMN),A LD A,(HL) ; Get the character back again CP CR+1 ; See if a JP C,SHOLIN ; If yes, send the new line CP ' ' JR NZ,LSTLP2 LD (SPCSTR),A JR LSTLP3 LSTLP2: LD (PNTCHR),A ; Show a printing character on the line LSTLP3: LD A,(COLUMN) ; See what column we are in now CP 78 JR NC,LSTWRP ; Exit if line is now too long LSTLP4: INC HL JP LSTLP ; Get the next character ; Line was too long, see why and fix the count accordingly LSTWRP: LD A,(HL) ; Get the character back CP ' ' ; Space at end of full line? JR Z,SHOLIN ; If yes, send the line LSTWR1: DEC HL LD A,(COLUMN) DEC A LD (COLUMN),A LD A,(SPCSTR) ; Any spaces yet? OR A JR Z,SHOLIN ; If not show what we have so far LSTWR2: LD A,(HL) CP '-' JR Z,SHOLIN CP ' ' JR NZ,LSTWR1 ; Neither of these, keep backtracking ; Ok all finished, now, display the line SHOLIN: LD A,(IX) OR A ; Message all finished? RET Z ; Yes, exit CP CR JR Z,LSTCR ; Exit if at end of this line CP ' ' JR C,LSTWR4 ; Ignore 01's and non-printing CALL @ECHO ; Display the character LD A,(COLUMN) DEC A LD (COLUMN),A JR Z,LSTCR ; If zero, no so add one LSTWR4: INC IX JR SHOLIN ; Do the next character ; Displays CR, resets the column counter, then checks to see if time for ; the [more] pause, returns with LF in 'A', not displayed yet. LSTCR: CALL LSTUP ; Display a CR and check for [more] OR A ; TWAIT: want to abort? RET Z CALL @ECHO ; Display the LF CALL ABORT ; Check for pause, skip or abort OR A RET NZ INC HL ; Increment for this character PUSH HL ; Transfer HL address to IX POP IX JP LSTLP ; Back to work for the next line LSTUP: XOR A LD (COLUMN),A ; Reset column counter LD (PNTCHR),A ; Reset printing character flag LD (SPCSTR),A ; Reset space character flag LD A,CR CALL @ECHO LD A,LF JP TWAIT ; Otherwise allow the [more] message ; Into the main part of the message now, check next character after CR ; to see if a space for a blank line or new paragraph, or end of msg. LSTNEW: INC HL ; Check next character LD A,(HL) OR A ; See if end of message JR Z,LSTN3 ; If yes, handle this CR normally CP ' ' ; Is it a space for blank line? JR Z,LSTN3 ; If yes, handle normally DEC HL ; Back to normal position LD A,(PNTCHR) ; Any printing chars. on line yet? OR A JR NZ,LSTN4 ; If yes, call this a 'soft return' DEC HL ; Else check ahead of this for a space LD A,(HL) CP ' ' ; Space for a blank line, etc. JR Z,LSTN2 ; If yes, keep the 'hard return' LSTN1: INC HL ; Back to current location LD A,' ' ; Call it a space then LD (HL),A ; Put into the message for now JP LSTLP1 ; Back to work LSTN2: INC HL ; Handle normally JP LSTLP1 LSTN3: DEC HL JP LSTLP1 ; Handle normally ; Line had some printing characters, check for a trailing space LSTN4: DEC HL LD A,(HL) CP ' ' ; Was it a trailing space? JR NZ,LSTN1 ; If not, call this a 'soft return' INC HL LD (HL),1 JP LSTLP ; Get next character, ignore this return ; end of display messages ;----------------------------------------------------------------------- NOMOR: CALL PRINT DB CR,LF,LF,'Finished.',0 JR DONEM1 DONEM: CALL PRINT DB 'uit',0 DONEM1: CALL PRINT DB CR,LF,LF,'Renumber messages (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JP NZ,NORNM ; If not, default is no renumber CALL PRINT ; Else, continue with renumber IF MSGTHD DB CR,LF,LF,'Updating Messages...',0 ELSE DB CR,LF,LF,'Renumbering messages...',0 ENDIF ; MSGTHD LD HL,(IMNDX) ; Get # of records in message index LD (ENDF),HL ; Store for end LD HL,0 ; Starting record number LD IX,1 ; Starting message number to message counter LD IY,(MSGARR) ; Point to start of array RNMLP: CALL GET ; Read record from message index file RNM1: LD HL,(MNUMF) ; Put old number LD (IY),L ; into array LD (IY+1),H IF MSGTHD PUSH IX ; Place counter on stack POP HL ; Get count from stack INC IX ; Next number ELSE LD (MNUMF),IX ; Change message number INC IX ; Next number LD HL,(MNUMF) ; ENDIF LD (IY+2),L ; New number to array as well LD (IY+3),H IF MSGTHD LD HL,(MFLNK) ; Get forward link LD (IY+4),L ; Save in array LD (IY+5),H LD HL,(MRLNK) ; Get reverse link LD (IY+6),L ; Save in array LD (IY+7),H LD HL,(MREPLY) ; Get reply to message number LD (IY+8),L ; Save in array LD (IY+9),H ENDIF ; MSGTHD LD HL,(RRNO1) CALL PUT ; Write record back to message index file RNMBMP: LD HL,(RRNO1) ; 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 JR NC,RNMDN ; If so, go wrap it up LD HL,(RRNO1) ; Else, increment current record number INC HL LD (RRNO1),HL IF MSGTHD LD BC,10 ; Adjust array pointer ELSE LD BC,4 ; Adjust array pointer ENDIF ; MSGTHD ADD IY,BC JP RNMLP ; And keep going RNMDN: CALL CLOSE ; Close message index file LD (IMNXT),IX IF MSGTHD ;============================================================================ ; RENLNK - Renumber links ENTRY HL = Address of Message Aray ; EXIT All messages renumbered (regs intact) ;============================================================================ ; Subroutine to renumber the messages and the forward and reverse links in ; the message index. We can process both forward and reverse links in one ; pass due to the fact that we've taken two extra bytes per message in the ; message array to store the old message number as well as the new one. ; Given the table below, we can process the links in the following manner... ; Links in ( ) represent values after renumbering. ; ; Old Msg New Msg Fwd Lnk Rev Lnk Reply ; ------- ------- ------- ------- ------- ; 1 1 5 (3) 0 (0) 0 (0) ; 2 2 10 (7) 0 (0) 0 (0) ; 5 3 6 (4) 1 (1) 0 (0) ; 6 4 8 (5) 5 (3) 0 (0) ; 8 5 9 (6) 6 (4) 0 (0) ; 9 6 0 (0) 8 (5) 0 (0) ; 10 7 0 (0) 2 (2) 0 (0) ; ; The basis for the renumbering technique is similar to a global find and ; replace. The FIND is the old message number, the REPLACE with is the new ; message number and the area to search is the FWD and REV links and the ; message REPLY. The major difference here is that the area to search is ; seperated by the OLD and NEW message numbers. This requires some major ; modifications in the way the search routines look for a match. RENLNK: PUSH HL PUSH DE PUSH BC CALL PRINT DB BS,BS,BS,', Index...',0 LD IX,(MSGARR) ; Get buffer address PUSH IX ; Save message array on stack LD HL,(IMNDX) ; Point to highest index number LD DE,10 ; Size of entry in message array CALL MLDL ; Compute entry to last message in index PUSH HL ; Place results on stack POP BC ; Get results in BC ADD IX,BC ; Point to last message LD L,(IX) ; Get old message number in HL LD H,(IX+1) LD (HIMSGN),HL ; Save for later checking POP IX ; Restore message array from stack RENMSG: PUSH IX ; Make IX and POP IY ; IY equal LD BC,10 ; Offset to next message number RFWLNK: LD L,(IX+4) ; Get old forward link LD H,(IX+5) ; into HL LD A,L ; Forward link = 0? OR H JR Z,RRVLNK ; If so, go do reverse link RFLNK1: LD E,(IY+0) ; Else, get old message LD D,(IY+1) ; number to check PUSH HL ; Save old forward link CALL SUBHL ; Numbers equal? POP HL ; First, restore old forward link JR Z,RFLNK2 ; If equal, found new forward link ADD IY,BC ; Else, calculate next message in array JR RFLNK1 ; Loop til we find a match RFLNK2: LD L,(IY+2) ; Get new message number LD H,(IY+3) ; into HL LD (IX+4),L ; and save it as LD (IX+5),H ; new forward link RRVLNK: LD L,(IX+6) ; Get old reverse link LD H,(IX+7) ; into HL LD A,L ; Reverse link = 0? OR H JR Z,RRPMSG ; If so, go do reply LD BC,-10 ; Else, want to go backwards this time RRLNK1: LD E,(IY+0) ; Get old message LD D,(IY+1) ; number to check PUSH HL ; Save old reverse link CALL SUBHL ; Numbers equal? POP HL ; First, restore old reverse link JR Z,RRLNK2 ; If equal, found new reverse link ADD IY,BC ; Else, calculate next message in array JR RRLNK1 ; Loop til we find a match RRLNK2: LD L,(IY+2) ; Get new message number LD H,(IY+3) ; into HL LD (IX+6),L ; and save it as LD (IX+7),H ; new reverse link RRPMSG: LD L,(IX+8) ; Get old reply LD H,(IX+9) ; into HL LD A,L ; Reply = 0? OR H JR Z,NXTMSG ; If so, go do next message LD BC,-10 ; Else, want to go backwards this time RRMSG1: LD E,(IY+0) ; Get old message LD D,(IY+1) ; number to check PUSH HL ; Save old reply CALL SUBHL ; Numbers equal? POP HL ; First, restore old reply JR Z,RRMSG2 ; If equal, found new reply ADD IY,BC ; Else, calculate next message in array JR RRMSG1 ; Loop til we find a match RRMSG2: LD L,(IY+2) ; Get new message number LD H,(IY+3) ; into HL LD (IX+8),L ; and save it as LD (IX+9),H ; new reply NXTMSG: LD L,(IX+0) ; Get old message number LD H,(IX+1) ; into HL LD DE,(HIMSGN) ; Get highest message number into DE CALL SUBHL ; Equal? JR Z,EXMSG ; If so, message array is all updated LD BC,10 ; Else get offset to next message number ADD IX,BC ; Calculate next message to process JP RENMSG ; and go do it EXMSG: LD IX,(MSGARR) ; Point to start of message array CALL MIOPEN ; Open message index file LD BC,10 ; Offset to next message number NMG: LD L,(IX+0) ; Get old message number LD H,(IX+1) PUSH BC CALL GETRC ; Convert msg # to record # LD HL,(RRNO1) ; Get record number CALL GET ; Get record from message index file LD L,(IX+2) ; Get new message number LD H,(IX+3) LD (MNUMF),HL ; Save in record LD L,(IX+4) ; Get forward link LD H,(IX+5) LD (MFLNK),HL ; Save in record LD L,(IX+6) ; Get reverse link LD H,(IX+7) LD (MRLNK),HL ; Save in record LD L,(IX+8) ; Get message reply LD H,(IX+9) LD (MREPLY),HL ; Save in record LD HL,(RRNO1) ; Get record number CALL PUT ; Save record LD L,(IX) ; Get next old message in [HL] LD H,(IX+1) LD DE,(HIMSGN) ; Get highest message number in [DE] POP BC ; Else, restore offset from stack ADD IX,BC ; Point to next entry in array CALL SUBHL ; Subtract to compare JP C,NMG ; If not equal, loop til done LD HL,MINDEX ; Else, point to message index file CALL CLOSE ; Close file POP BC ; Restore stack POP DE POP HL ENDIF ; MSGTHD USNUM: CALL PRINT IF MSGTHD DB BS,BS,BS,', Users...',0 ELSE DB CR,LF,'Updating users file...',CR,LF,0 ENDIF ; MSGTHD CALL UOPEN ; Open users file LD HL,MAXU-1 ; Number of records USNLP: CALL GET LD A,(AVAILF) ; See if active OR A JR Z,USNXT ; Not an active record, so do next one USNLP0: 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,(RRNO1) ; and put it CALL PUT ; back in users file USNXT: IF NOT MSGTHD CALL PRINT DB '.',0 ENDIF ; NOT MSGTHD LD HL,(RRNO1) DEC HL LD A,H CP 0FFH ; Done with records? JR NZ,USNLP NORNM: CALL CLOSE ; Message index file LD DE,MMSGT ; Destination for current time LD HL,MMSGD ; Destination for current date CALL SAVTIM ; Get date/time and move to destination LD HL,IDATE LD DE,IDATEF LD BC,NDXLEN LDIR ; Move index to buffer CALL IOPEN ; Open index file CALL PUT ; Update index CALL CLOSE ; Index file CALL PRINT IF MSGTHD DB CR,LF,0 ELSE DB CR,LF,'All done...',CR,LF,0 ENDIF ; MSGTHD JP SYS1 ; All done BACKM: CALL PRINT DB 'revious',0 PUSH IY POP HL DEC HL DEC HL PUSH HL ; Save in case ok LD DE,(MSGARR) ; See if passed start of array AND A ; Clear carry SBC HL,DE ; Ok? JR 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 DB CR,LF,LF,'Hard-log now ',0 LD A,(SYSLOG) CP 1 JR NZ,LGOFF CALL PRINT DB 'ON.',0 JR MHLG1 LGOFF: CALL PRINT DB 'OFF.',0 MHLG1: CALL PRINT DB CR,LF,LF,'Enter Q to quit, N for on, F for off: ',0 MHWT: CALL GETCH CALL CAPS CP 'F' JR Z,OFF CP 'N' JR Z,ON CP 'Q' JP Z,HLGDON JR MHWT OFF: CALL ECHO XOR A JR NFDON ON: CALL ECHO LD A,1 NFDON: LD (SYSLOG),A JP MHLG BHLG: CALL @PRNT DB CR,LF,LF,'BYE Hard-log now ',0 LD A,(HRDLOG) CP 1 JR NZ,BLGOFF CALL @PRNT DB 'ON.',0 JR BHLG1 BLGOFF: CALL @PRNT DB 'OFF.',0 BHLG1: CALL @PRNT DB CR,LF,LF,'Enter Q to quit, N for on, F for off: ',0 BHWT: CALL GETCH CALL CAPS CP 'F' JR Z,BOFF CP 'N' JR Z,BON CP 'Q' JP Z,HLGDON JP BHWT BOFF: CALL @ECHO XOR A JR BFDON BON: CALL @ECHO LD A,1 BFDON: LD (HRDLOG),A JP BHLG PCALRS: LD HL,CALRS2 ; Point to name of callers backup file LD DE,CALLRS ; Name of callers file (from PBBSDB.HDR) CALL MOV2DT ; Move the name (up to the dot) LD (HL),'.' ; Now the dot INC HL ; Point next EX DE,HL ; Swap registers LD HL,BAKNM ; Point to 'BAK' LD BC,3 ; 3 bytes to move LDIR ; Move 'em CALL PRINT DB CR,LF,LF DB 'This routine will erase ',0 LD HL,CALRS2 ; Point to name of callers backup file CALL PRINTM ; Print it CALL PRINT DB ', if it is present.' DB CR,LF,'Continue (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JR Z,PCAL1 ; If so, go do it CALL PCRLF ; Else, turn up a new line JP PCAL5 ; and skip callers file compress PCAL1: CALL ECHO CALL PCRLF LD HL,CALLRS ; Point to callers file name (PBBSDB.HDR) CALL OPEN CP 0FFH ; Did it exist? JR NZ,PCAL2 ; If so, go compress it CALL PCRLF ; Else, turn up new line LD HL,CALLRS ; Point to callers file name CALL PRINTM ; Print it CALL PRINT DB ' file not found.',CR,LF,0 JP PCAL5 PCAL2: CALL CLOSE LD HL,CALRS2 ; Point to name of callers backup file CALL BFCB ; Make an FCB LD DE,FCB ; Now delete CALL KILBDOS ; that file, if it exists CALL PRINT DB CR,LF,'Renaming ',0 LD HL,CALLRS ; Point to name of callers file CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,CALRS2 ; Point to name of callers backup file CALL PRINTP ; Print it CALL PRINT DB '...',0 LD HL,CALLRS ; Point to callers file name (PBBSDB.HDR) LD DE,RENC1 ; Point to old callers file name FCB CALL BFCB1 ; Make an FCB at RENC1 LD HL,CALRS2 ; Point to callers backup file name LD DE,RENC3 ; Point to new callers file name FCB CALL BFCB1 ; Make an FCB at RENC3 LD DE,RENC1 ; Point to rename FCBs CALL RENBDOS ; Go rename them CP 0FFH JP Z,PERR CALL PCAL3 JP PCAL5 PCAL3: CALL PRINT DB CR,LF,'Transferring ',0 LD HL,CALRS2 ; Point to name of callers backup file CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,CALLRS ; Point to name of callers file CALL PRINTP ; Print it CALL PRINT DB '...',0 LD HL,CALRS2 CALL OPEN LD HL,CALLRS CALL OPEN2 LD HL,64 ; Get length of each record LD (RRSZ1),HL ; into source parameter block LD (RRSZ2),HL ; and dest parameter block LD HL,0 ; Get record number CALL GET64 LD HL,(RNDBUF) ; Contained in first 2 bytes of record 0 XOR A ; Clear the carry LD DE,21 ; One extra for pre-increment SBC HL,DE JP M,SMCALR ; Callers file too small to pack LD (RRNO1),HL ; Our starting record # LD A,21 ; LD (LINES),A ; We copy 20 or less LD IX,1 ; Start with record 1 PCAL4: LD HL,LINES DEC (HL) JR Z,PCLEND LD HL,(RRNO1) INC HL CALL GET64 PUSH IX POP HL ; Get record number to write INC IX ; Point to next record CALL PUT264 ; Write new record JR PCAL4 PCLEND: CALL CLOSE LD HL,0 ; Record zero is the counter LD (RNDBUF),IX CALL PUT264 CALL CLOSE2 CALL PRINT DB ' Done.',CR,LF,0 RET SMCALR: CALL CLOSE ; Close everthing CALL CLOSE2 ; Ditto LD HL,CALLRS ; Point to name of callers file CALL BFCB LD DE,FCB ; Kill CALLERS if there CALL KILBDOS CALL PRINT DB CR,LF,'Caller file too small',CR,LF DB 'Renaming ',0 LD HL,CALRS2 ; Point to name of callers backup file CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,CALLRS ; Point to name of callers file CALL PRINTP ; Print it CALL PRINT DB '...',0 LD HL,CALRS2 ; Point to callers backup file name LD DE,RENC2 ; Point to old callers file name FCB CALL BFCB1 ; Make an FCB at RENC2 LD HL,CALLRS ; Point to callers file name (PBBSDB.HDR) LD DE,RENC4 ; Point to new callers file name FCB CALL BFCB1 ; Make an FCB at RENC4 LD DE,RENC2 ; Point to rename FCBs CALL RENBDOS ; Go rename them CP 0FFH JP Z,PERR RET PCAL5: IF MSTATS CALL IOPEN ; Open the index file CALL GET ; Get record CALL PRINT DB CR,LF,LF DB 'Do you wish to zero current day''s usage (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JR Z,PCAL5B ; If so, continue CALL PCRLF ; Else, turn up a new line JR PCAL5C ; and skip next PCAL5B: CALL PCRLF LD HL,IDATEF ; Source LD DE,IDATE ; Destination LD BC,NDXLEN ; Length LDIR ; Block move buffer to storage XOR A LD (SYCRP),A ; Zero System Current Percent LD (SYPVP),A ; Zero System Previous Percent LD (SYDCC),A ; Zero Daily Call Counter LD HL,0 LD (SYACU),HL ; Zero System Daily Accumulator LD HL,IDATE ; Source LD DE,IDATEF ; Destination LD BC,NDXLEN ; Length LDIR ; Block move storage to buffer LD HL,0 ; Point to first record CALL PUT ; Write record PCAL5C: CALL PRINT DB CR,LF,LF DB 'Do you wish to zero accumulated system stats (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JR Z,PCAL5D ; If so, continue CALL PCRLF ; Else, turn up new line JR PCAL5E ; and skip next PCAL5D: CALL PCRLF LD HL,RNDBUF LD B,NDXLEN SY3LP: LD (HL),0 INC HL DJNZ SY3LP LD HL,2 ; Point to third record CALL PUT ; Write record CALL PRINT DB CR,LF DB 'System Usage fields all initialized to zero in INDEX file...' DB CR,LF,LF,0 PCAL5E: CALL CLOSE ; Close INDEX file ENDIF ; MSTATS JP SYS1 PACK: CALL PRINT DB CR,LF,LF,BEL DB 'These routines MAY take many minutes to complete.' DB CR,LF,LF,'This routine will erase any of:' DB CR,LF,'INDEX, MESSAGES, MSGINDEX, - ".BAK"' DB CR,LF,' (backup) files that are present.' DB CR,LF,'Continue (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JP NZ,SYS1 ; If not, quit CALL PCRLF1 LD HL,INDEX2 ; Location for name of index backup file LD DE,INDEX ; Name of index file (from PBBSDB.HDR) CALL MOV2DT ; Move the name (up to the dot) LD (HL),'.' ; Now the dot INC HL ; Point next EX DE,HL ; Swap registers LD HL,BAKNM ; Point to 'BAK' LD BC,3 ; 3 bytes to move LDIR ; Move 'em LD HL,INDEX2 ; Location for name of index backup file CALL BFCB ; Make an FCB LD DE,FCB ; Now delete CALL KILBDOS ; that file, if it exists LD HL,MSGIN2 ; Repeat for message index file LD DE,MINDEX ; Name of message index file (from PBBSDB.HDR) CALL MOV2DT ; Move the name (up to the dot) LD (HL),'.' ; Now the dot INC HL ; Point next EX DE,HL ; Swap registers LD HL,BAKNM ; Point to 'BAK' LD BC,3 ; 3 bytes to move LDIR ; Move 'em LD HL,MSGIN2 ; Location for name of msg index backup file CALL BFCB ; Make an FCB LD DE,FCB ; Now delete CALL KILBDOS ; that file, if it exists LD HL,MESSA2 ; And for MESSAGES.BAK LD DE,MSGS ; Name of message file (from PBBSDB.HDR) CALL MOV2DT ; Move the name (up to the dot) LD (HL),'.' ; Now the dot INC HL ; Point next EX DE,HL ; Swap registers LD HL,BAKNM ; Point to 'BAK' LD BC,3 ; 3 bytes to move LDIR ; Move 'em LD HL,MESSA2 ; Location for name of message backup file CALL BFCB ; Make an FCB LD DE,FCB ; Now delete CALL KILBDOS ; that file, if it exists CALL PRINT DB CR,LF,'Renaming ',0 LD HL,INDEX ; Point to name of index file (PBBSDB.HDR) CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,INDEX2 ; Point to name of index backup file CALL PRINTP ; Print it LD HL,INDEX ; Name of index file (from PBBSDB.HDR) LD DE,RENI1 ; Point to old index file name FCB CALL BFCB1 ; Make an FCB LD HL,INDEX2 ; Point to name of index backup file LD DE,RENI2 ; Point to new index file name FCB CALL BFCB1 ; Make an FCB LD DE,RENI1 ; Point to file names for index file CALL RENBDOS ; and rename CP 0FFH JP Z,PERR CALL PRINT DB CR,LF,'Renaming ',0 LD HL,MSGS ; Point to name of message file (PBBSDB.HDR) CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,MESSA2 ; Point to name of message backup file CALL PRINTP ; Print it LD HL,MSGS ; Name of message file (from PBBSDB.HDR) LD DE,RENM1 ; Point to old message file name FCB CALL BFCB1 ; Make an FCB LD HL,MESSA2 ; Point to name of message backup file LD DE,RENM2 ; Point to new message file name FCB CALL BFCB1 ; Make an FCB LD DE,RENM1 ; Point to file names for message file CALL RENBDOS ; and rename CP 0FFH ; Error? JP Z,PERR ; If so, go tell us about it CALL PRINT ; Else, on to message index file DB CR,LF,'Renaming ',0 LD HL,MINDEX ; Point to name of msg index file (PBBSDB.HDR) CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,MSGIN2 ; Point to name of msg index backup file CALL PRINTP ; Print it LD HL,MINDEX ; Name of msg index file (from PBBSDB.HDR) LD DE,RENX1 ; Point to old msg index file name FCB CALL BFCB1 ; Make an FCB LD HL,MSGIN2 ; Point to name of msg index backup file LD DE,RENX2 ; Point to new msg index file name FCB CALL BFCB1 ; Make an FCB LD DE,RENX1 ; Point to file names for message index CALL RENBDOS ; and rename CP 0FFH ; Error? JP Z,PERR ; If so, tell us NOCLR: CALL PRINT ; Else, begin transferring files DB CR,LF,'Transferring ',0 LD HL,INDEX2 ; Point to name of index backup file CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,INDEX ; Point to name of index file CALL PRINTP ; Print it CALL PRINT DB '...',0 LD HL,INDEX2 ; Transfer index backup to index file CALL OPEN ; Index backup file LD HL,INDEX CALL OPEN2 ; Index file LD HL,NDXLEN LD (RRSZ1),HL LD (RRSZ2),HL LD HL,0 ; Get old index - first record PUSH HL CALL GET POP HL CALL PUT2 ; Write it to new file LD HL,1 ; Get old index - copy of first record PUSH HL CALL GET POP HL CALL PUT2 ; Write it to new file LD HL,2 ; Get old index - 31 day stats PUSH HL CALL GET POP HL CALL PUT2 ; Write it to new file CALL CLOSE CALL CLOSE2 CALL PRINT DB ' Done.',CR,LF DB 'Transferring ',0 LD HL,MSGIN2 ; Point to name of msg index backup file CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,MINDEX ; Point to name of msg index file CALL PRINTP ; Print it CALL PRINT DB '...',0 LD HL,MSGIN2 CALL OPEN ; Message index backup file LD HL,MINDEX CALL OPEN2 ; Message index file LD HL,MNDXLN ; Get length of each record LD (RRSZ1),HL ; into source parameter block LD (RRSZ2),HL ; and dest parameter block LD HL,(IMNDX) LD (ENDF),HL LD HL,0 ; Starting record number for source LD IX,0 ; and for destination PMILP: CALL GET ; Get old message index record LD A,(MREAD) ; See if active CP -1 JR 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 PMIBMP: LD HL,(RRNO1) ; Get last record read INC HL ; Bump by one LD DE,(ENDF) ; Check for end INC DE AND A SBC HL,DE JR NC,PMIDON ; If end, go wrap up LD HL,(RRNO1) ; Else, get last record read, INC HL ; bump it JR 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 DB ' Done.',CR,LF DB 'Transferring ',0 LD HL,MESSA2 ; Point to name of message backup file CALL PRINTP ; Print it CALL PRINT DB ' to ',0 LD HL,MSGS ; Point to name of message file CALL PRINTP ; Print it CALL PRINT DB '...',0 LD IX,0 ; Clear counter LD HL,(IMNDX) ; Get number of records LD (CURREC),HL ; Set current record LD HL,MSGS ; Message file CALL OPEN2 ; Open new messages file (stays open) LD HL,MSGLEN LD (RRSZ2),HL PMSLOP: CALL MIOPEN ; Open message index file LD HL,(CURREC) ; Get this record number PUSH HL ; Save it for write CALL GET ; Read record LD A,(MBLKF) ; Get and save LD (BLOCKS),A ; number of blocks LD HL,(MSTRF) LD (STRT),HL ; starting record number LD (MSTRF),IX ; Save new starting record number POP HL ; Restore current msg index record number CALL PUT ; Save msg index record CALL CLOSE ; Done with index for now LD HL,MESSA2 ; Message backup file CALL OPEN LD HL,MSGLEN LD (RRSZ1),HL LD A,(BLOCKS) LD B,A ; Set counter to number of blocks LD DE,(MSGARR) ; DE points to start of transfer buffer PMSLP1: PUSH BC ; Save counter LD HL,(STRT) ; Get record number to read PUSH DE ; Save transfer buffer pointer CALL GET64 ; Get block POP DE ; Restore transfer buffer pointer LD HL,(STRT) ; Get record number and INC HL ; bump it then LD (STRT),HL ; save it LD HL,RNDBUF ; Point to random buffer LD BC,MSGLEN ; Length of one message record LDIR ; Move record to transfer buffer POP BC ; Restore counter DJNZ PMSLP1 ; Loop til entire message read LD HL,(MSGARR) ; HL points to start of transfer buffer LD A,(BLOCKS) LD B,A ; Set counter to number of blocks PMSLP2: PUSH BC ; Save the counter LD DE,RNDBUF ; DE points to random buffer LD BC,MSGLEN ; Length of one message record LDIR ; Move from transfer buffer PUSH HL ; Save tranfer buffer pointer PUSH IX ; New record number POP HL ; to HL INC IX ; Point to next record to write CALL PUT264 ; Write record POP HL ; Restore tranfer buffer pointer POP BC ; Restore counter DJNZ PMSLP2 ; Do til done with this message CALL CLOSE ; Finished with old messages file for now LD HL,(CURREC) ; See if at end of new index yet DEC HL LD A,H CP 0FFH JR 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 CLOSE CALL CLOSE2 ; Close files CALL PRINT DB ' Done.',CR,LF,'Updating ',0 LD HL,INDEX ; Point to name of index file (PBBSDB.HDR) CALL PRINTM ; Print it CALL PRINT DB '...',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 DB CR,LF,'Old index info now in second record of',CR,LF,0 LD HL,INDEX ; Point to name of index file (PBBSDB.HDR) CALL PRINTM ; Print it CALL PRINT DB ' and in ',0 LD HL,INDEX2 ; Point to name of index backup file CALL PRINTM ; Print it CALL PRINT DB ' for safety.',CR,LF,LF,0 JP SYS1 PERR: CALL PRINT DB ' -- Fatal error...',0 JP EXIT ; User 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: LD IX,(MSGARR) ; Get pointer to array area PUSH IX ; and save it LD (IX),0 LD (IX+1),0 ; With 2 nulls CALL PRINT DB CR,'Scanning user file.',CR,LF DB 'The following users would be deleted :',CR,LF,0 CALL UOPEN LD HL,MAXU-1 ; Number records INC HL ; Force record #+1 LD (RRNO1),HL ; to record # counter SRTLP: LD HL,(RRNO1) 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 --> number of days of inactivity that is allowed. LD A,(HL) LD (DELLEV),A ; A=days to deletion LD IY,IDATE ; 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 deletion OR A ; 0=no delete JR Z,SRTLP ; Don't bother LD D,0 LD E,A ; Days tolerated to DE AND A ; Clear carry SBC HL,DE ; HL(inactivity) > DE(tolerated)? JR Z,SRTLP ; Equal so... JR C,SRTLP ; Okay so don't delete LD HL,UNAMEF LD B,30 CALL PRINTN CALL PCRLF NOM: JR SRTLP UPD252: CALL CLOSE POP IX ; Get back end of array (if existing) CALL PRINT DB ' Done.',CR,LF,0 JP SYS1 CLKERR: POP IY ; Clear the stack CALL CLOSE ; Close any open files CALL PRINT DB BEL,'Date error!',CR,LF DB 'The following user has an invalid date: ',0 LD HL,UNAMEF LD B,30 CALL PRINTN JP MUSR ; Go to the user maintenance IF MSTATS SYCALC: PUSH AF ; Hold onto DAY LD A,(BDATE+1) ; Check current DAY LD B,A ; Move it into B POP AF ; Get back display DAY PUSH AF ; and keep a copy on the stack CP B ; Match? LD HL,SYBLK ; Point HL to no match msg JR NZ,SYCAL1 ; Nope LD HL,SYPTR ; Yep, this is the same DAY SYCAL1: CALL PRINTM ; Print msg pointed to by HL in positions 1-4 POP AF ; Get back display DAY PUSH AF CALL PA2ASC ; Print, with leading 0 is necessary CALL PRINT DB ' ',0 ; Spaces in positions 7-10 POP AF ; Restore day PUSH AF ; and save it again LD B,A ; Multiply if by 3 ADD A,A ; A x 2 ADD A,B ; A x 3 LD L,A LD H,0 ; Result in HL LD DE,RNDBUF ; DE points to beginning of record #3 ADD HL,DE ; HL now points to correct day storage location LD DE,SYACU ; DE = destination LD BC,3 ; BC = length LDIR ; Block move into offical names area LD HL,(SYACU) ; Total Daily Minutes LD DE,60 ; 60 min/hr CALL DIV16 ; HL / DE = HL (total hours), DE (minutes) PUSH DE ; Hang onto this LD A,L CALL PA2ASC ; Display with leading 0 if necessary CALL PRINT DB ':',0 ; Customary separator in position 13 POP DE ; Restore minutes LD A,E CALL PA2ASC ; Display with leading 0 if necessary CALL PRINT DB ' ',0 ; Spaces in positions 16-18 LD A,(SYDCC) ; Daily Call Count CP 100 ; More than 100? JR NC,SYCAL2 ; Yes, go print it PUSH AF ; Else, save count LD A,' ' ; Then print CALL @ECHO ; another space (position 19) POP AF ; Restore call count SYCAL2: CALL PA2ASC ; Display with leading 0 if necessary CALL PRINT DB ' ',0 ; Spaces in positions 22-26 LD A,(SYDCC) ; Total Daily Calls OR A LD L,A LD H,A JR Z,SYNDIV ; Don't bother dividing by zero callers LD HL,(SYACU) ; Total Daily Minutes LD E,A LD D,0 CALL DIV16 ; HL / DE = Average Call Duration in HL SYNDIV: PUSH HL LD A,L CP 100 JR NC,SYNFL6 ; Don't need a ' ' filler CALL PRINT DB ' ',0 POP HL LD A,L CALL PA2ASC JR SYNF6A SYNFL6: POP HL CALL PB2ASC ; Display ACD in positions 27-29 SYNF6A: CALL PRINT DB ' ',0 ; Spaces in positions 30-33 LD HL,(SYACU) ; Total Daily Minutes LD DE,10 ; Keep numbers within 16-bits CALL MLDL ; HL * DE = HL (system minutes times 10) LD DE,144 ; Total minutes in day divided by 10 CALL DIV16 ; HL / DE = HL, System Usage Percentage LD A,L SYNF6B: CALL PA2ASC ; Display with leading 0 if necessary CALL PRINT DB ' % ',0 ; Space and % in positions 36-38 POP AF ; Get working DAY back RET ENDIF ; MSTATS SYSRED: 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 IF MSTATS CALL PRINT DB CR,LF,LF DB ' *** 31-day System Statistics Summary ***' DB CR,LF,LF DB ' Total Avg Total Avg' DB CR,LF DB ' Day HH:MM Callers CD % Usage Day HH:MM Callers CD % Usage' DB CR,LF DB '---------------------------------------|--------------------------------------' DB CR,LF,0 CALL GETRTC ; To get a valid BDATE CALL CDATE CALL RDCLOK CALL IOPEN ; Open index file, pointing to record #1 LD HL,2 ; Point to record #3 CALL GET ; Read into RNDBUF LD A,1 ; Initialize DAY counter SYDLP: CALL SYCALC ; Display data in first column PUSH AF ; Save first column DAY CALL PRINT DB ' |',0 ; Align cursor for second column POP AF ; PUSH AF ADD A,16 ; Point to DAY #17, #18, #19, etc... CALL SYCALC ; Display data in second column CALL PCRLF POP AF INC A ; Point to DAY #2, #3, #4, etc... CP 16 JR C,SYDLP ; Less than 16, loop CALL SYCALC ; 16th day only in first column CALL PRINT DB CR,LF,' ' DB ' NOTE: => points to current DAY',CR,LF,LF,0 CALL CLOSE ; Close INDEX file SYWAIT: CALL PRINT DB CR,' Do you wish to read the Sysop Log (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JP NZ,SYSEX1 ; If not, exit now CALL @PRNT ; Else, turn up 2 new lines DB CR,LF,LF,0 ENDIF ; MSTATS LD HL,COMMENTS ; Point to name of comments file (PBBSDB.HDR) CALL OPEN LD HL,64 LD (RRSZ1),HL ; Record size LD HL,0 CALL GET64 ; Get next record 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 DB CR,LF,LF,'No records found. Next record number = 1',CR,LF,0 JP SYSXIT 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 (RRNO1),HL RECLOP: PUSH BC ; Save counter LD HL,(RRNO1) INC HL ; Set to next record CALL GET64 ; Get next record LD HL,RNDBUF ; Point to text LD B,64 ; Length of text line CALL @PRNTL ; Print line 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 DB 'Finished...',0 SYSXIT: CALL @PRNT DB CR,LF,LF,'Erase old comments (y/N)? ',0 CALL DEFNO ; Get an answer CP 1 ; Yes? JR NZ,SYSEX1 ; If not, exit now CALL @PRNT ; Else, erase the comments file DB CR,LF,'Erasing old comments file...',0 LD HL,COMMENTS ; Point to comments filename (PBBSEQU.HDR) CALL BFCB LD DE,FCB ; Kill COMMENTS.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 DB ' Done...',CR,LF,0 JP SYS1 ; Subroutine to open the user file at FCB2. UOPEN1: LD HL,USERS ; Point to filename CALL OPEN1 ; Get user info to memory LD HL,USRLEN ; Length of record LD (RRSZ2),HL RET ; Subroutine to pad the display with spaces from 'PADSTR' (in PBBSDB.HDR). ; Number of spaces to print in B. PAD: LD A,B ; If B=0 OR A ; then return RET Z ; immediately LD HL,PADSTR ; Else, point to string of spaces CALL @PRNTL ; Print 'B' of 'em RET COND (NMFLDRS GT 1) ; This routine will display the contents of the folder access bits. ; The access to each folder is stored in the ACCTBL table. If a table entry ; is 0 the user does not have access to the folder, 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 folder, as the Access ; bump logic within PBBS will set a 0 access to a 1 access if the user's ; access level is >= the minimum required to access a folder, unless the ; Sysop has blocked access. DO NOT CHANGE THIS CODE or YOU MAY HAVE A ; DISASTER on your HANDS. DACC: LD HL,ACCTBL ; Get address of access table into HL LD (HL),0 ; Zero the first byte of the table PUSH HL PUSH HL INC HL EX DE,HL POP HL LD BC,9 LDIR POP HL LD (HL),1 INC HL LD (HL),1 INC HL LD B,8 LD IX,UFACCF ; Point to access control bytes DACC1: RRC (IX+0) JR NC,DACC2 LD (HL),-1 ; Else, block access to that folder RRC (IX+1) JR DACC3 DACC2: RRC (IX+1) JR NC,DACC3 LD (HL),1 ; Else, allow access DACC3: INC HL DJNZ DACC1 LD IX,ACCTBL+1 LD B,NMFLDRS-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: DB ' ',0 POP IX POP BC DJNZ DACC6 RET SFLDR2: LD HL,FNAMES+3 ; Point to "GLOBAL" folder OR A CALL NZ,CNAME ; If not zero, go set [HL] to name LD B,25 CALL @PRNTL RET ; Get the folder name of the active folder and display it after ; the user's folder number (may not be the actual folder number). CNAME: LD HL,FNAME1 ; Point to folder names DEC A ; Decrement for base 0 ADD A,A ; Multiply by 16 ADD A,A ADD A,A ADD A,A LD B,0 LD C,A ; BC now has offset ADD HL,BC ; Add to base to form true address RET DFLDR: CALL PRINT DB CR,LF,'Your Folders are:',CR,LF,0 DFLDR2: LD HL,FNAME1 LD A,1 LD BC,16 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 NMFLDRS+1 JR NC,DDONE CALL PA2ASC ; Print folder number with leading zero CALL PRINT DB '. ',0 POP HL POP BC PUSH BC PUSH HL CALL PRINTL CALL PCRLF JR DLOOP DDONE: POP HL POP BC POP AF CALL PCRLF RET ENDC ; (MFLDRS GT 1) ;----------------------------------------------------------------------- ; KILBDOS presets C reg to kill a file, while ; RENBOS presets C reg to rename a file. ; The SPBDOS call jumps to the BDOS after saving IX and IY. KILBDOS:LD C,13H JP SPBDOS RENBDOS:LD C,17H JP SPBDOS EATCHR: LD E,0FFH LD C,06H CALL SPBDOS OR A JR NZ,EATCHR RET ;*********************************************************************** ; SUBROUTINE: DEFYES and DEFNO ; PURPOSE: Get a character from the keyboard, determine if it is ; a 'Y' (for yes), an 'N' (for no) or some other characer. ; If Y or N, print the appropriate word, if not, depending ; on whether YES or NO is the default, print the default. ; INPUT: none ; OUTPUT: Zero flag set if answer is NO or default = NO (A = 0) ; Sign flag reset if answer is YES or default = YES (A = 1) ; USES: A,HL ; CALLS: YESNO ;*********************************************************************** DEFYES: CALL YESNO JP M,PRYES RET DEFNO: CALL YESNO JP M,PRNO RET ;*********************************************************************** ; SUBROUTINE: YESNO ; PURPOSE: Get a character from the keyboard, determine if it is ; a 'Y' (for yes), an 'N' (for no) or some other characer. ; If Y or N, print the appropriate word ; INPUT: none ; OUTPUT: Zero flag set if answer is NO (A = 0) ; Sign flag reset if answer is YES (A = 1) ; Sign flag set if some other character was entered (A = -1) ; USES: A,HL ; CALLS: GETCH or GTCHCR ; PRINTM ;*********************************************************************** YESNO: CALL GETCH ; Get input CALL CAPS CP 'Y' JR Z,PRYES CP 'N' JR Z,PRNO XOR A ; Clear zero DEC A ; Set minus RET PRYES: LD HL,YESMSG CALL PRINTM XOR A ; Clear zero INC A ; Set plus RET PRNO: LD HL,NOMSG CALL PRINTM XOR A ; Set zero flag RET ;*********************************************************************** ; SUBROUTINE: HASH ; PURPOSE: Calc pos'n in USERS.PBS to start search ; INPUT: A =first character of last name ; OUTPUT: HL=pos'n in USERS.PBS to begin search ; USES: A,DE,HL ;*********************************************************************** HASH: SUB 41H ; Make it 0 thru 25 ADD A,A ; Double it LD HL,HSHTBL ; Point to start of table LD E,A ; Calc pos'n in table LD D,0 ADD HL,DE LD A,(HL) ; Get starting pos'n in HL INC HL LD H,(HL) LD L,A RET SEARCH: XOR A ; Clear pass flag LD (PFLG),A LD A,C ; Test for OR A ; a valid record JR NZ,SRCH1 ; Get new record LD A,B ; Test high order OR A RET Z ; Return if so SRCH1: LD A,(IY+1) ; Compare to current number CP B JR Z,SRCH2 ; Not dead yet! JR NC,PASTIT ; Oops, past it JR SRCH3 ; No, try next one SRCH2: LD A,(IY) ; Now low 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 C,(IY+2) ; Get the new value LD B,(IY+3) RET ; And return LTHAN: LD BC,1 ; Set as low a possible RET ; And return ; Subroutine to stop display every 24 lines TWAIT: PUSH BC PUSH HL PUSH AF LD HL,TLINES DEC (HL) JR NZ,TWTRTN TWLF: LD HL,MORE CALL PRINTM TWAIT1: CALL GETCH CP 'K'-'@' JR Z,TWABRT CALL CAPS CP 'K' JR Z,TWABRT CP 'Q' JR Z,TWABRT CP ' ' ; Space prints 1 more line LD A,1 ; Just in case it is a space JR Z,TWAIT2 LD A,23 ; Nope, so print another full screen TWAIT2: LD (TLINES),A LD HL,MORE1 CALL PRINTM POP AF LD A,CR ; Make the caller print the CR PUSH AF JR TWTRTN TWABRT: POP AF XOR A PUSH AF TWTRTN: POP AF POP HL POP BC RET ; Aborts the display when requested, but only at end of line. ABORT: PUSH HL ; Save the TBUF address PUSH DE PUSH BC LD E,0FFh LD C,6 CALL SPBDOS ; See if we got a character OR A JR Z,ABORT3 ; If no key pressed, then continue CP 'S'-'@' ;^S to pause JR Z,ABRTWT ; Wait for next character CP 'K'-'@' JR Z,ABORT2 CALL CAPS CP 'S' ; S to pause? JR NZ,ABORT1 ; If not, then exit ABRTWT: CALL GETCH ; Otherwise wait for another character CP 'K'-'@' ; Does he want to quit? JR Z,ABORT2 ; Yup.. CALL CAPS ; Check a Q too... ABORT1: CP 'Q' ; Is it 'Q' to quit? JR Z,ABORT2 CP 'K' ; Is it 'K' to quit? JR Z,ABORT2 JR ABORT3 ABORT2: CALL PRINT ; If yes, then print abort message DB CR,LF,'++ ABORTED ++',CR,LF,0 POP BC ; Reset the stack POP DE POP HL XOR A ; Reset INC A ; zero flag RET ABORT3: XOR A ; Set zero flag POP BC POP DE POP HL RET ; Shell-Metzner sort - from KILOBAUD April 1981 - Albert J. Marino 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, goto 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 ; Read the RTC (in ASCII at DATE and TIME), convert the date and time to ; binary (at BDATE and BTIME respectively), then move the binary date to ; (HL) and the binary time to (DE). If either DE or HL is zero, then don't ; move that value. SAVTIM: PUSH HL ; Save date location PUSH DE ; Save time location CALL RDCLOK ; Update binary date & time at BDATE & BTIME LD HL,BTIME ; Point to binary time POP DE ; Restore destination for time CALL STIM1 LD HL,BDATE ; Point to binary date POP DE ; Restore destination for date STIM1: LD A,E ; Test OR D ; for zero RET Z ; If so, don't move it LD BC,3 ; Else, move data LDIR ; to correct location RET RDCLOK: CALL GETRTC ; Get date and time from BYE CALL CDATE ; Convert date to binary CALL CTIME ; Convert time to binary RET ; Read the RTC (through BYE). 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: PUSH BC ; Save regs LD B,2 ; Set up counter BCD2A1: LD A,'0' ; Prepare A reg RLD ; Convert high nibble LD (DE),A ; Place it in string INC DE ; Point next DJNZ BCD2A1 ; Do it twice POP BC ; Restore reg 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 0F0H ; 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 HL LD HL,BSTOR ; Point to temporary storage LD (HL),255 ; -1 BLP: INC (HL) ; Increment 10's counter SUB 10 ; Subtract 10 each pass JR NC,BLP ADD A,10 ; Get back number RLD ; Combine the two in temp storage LD A,(HL) ; Get BCD into [A] POP HL RET ;---------------------------------------------------------------------------- ; Data Area ;---------------------------------------------------------------------------- DATA EQU $ COND NMFLDRS GT 1 ICHI: DB 0 ; Temp storage for 'G','R', or 'B' input ENDC DUMFON: DB '000-000-0000' DSHSTR: DB '______________________________',0 SYSSTR: DB 'SYSOP',0 ; Used for comparisons when name not wanted TLINES: DB 0 ; Screen line counter PNTCHR: DB 0 ; Reset printing character flag SPCSTR: DB 0 ; Reset space character flag BSTOR: DW 0 ; Storage for BINBCD routine IF MSTATS SYPTR: DB '=> ',0 SYBLK: DB ' ',0 ENDIF ; MSTATS MORE: DB CR,LF,' [more]',CR,0 MORE1: DB ' ',0 STARTM: DB 'START',0 ENDM: DB 'END',0 TRECNO: DW 0 ; Temp rec no. storage ENDF: DW 2 DELE: DW 2 ; Address of start of delete array HSHREC: DW 0 STRT: DW 0 CURREC: DW 0 UCOUNT: DW 0 COLUMN: DW 0 MSGREC: DW 0 SYSFLG: DLEVEL: DB 0 BLOCKS: DB 0 LINES: DB 0 ACCTMP: DB 0 ACCTBL: DS 10 MTOTMP: DS 30 SFLDR: DS 1 CF: DB 0 ; Flag for the change folder routine KF: DB 0 ; Flag for the kill routine UF: DB 0 ; Flag for the un-delete routine IYHOLD: DW 0 ; Hold area used in un-delete routine IYEND: DW 0 ; End of mailtable (in maint) SHDEL: DB 0 ; Show deleted msgs (0=no, -1=yes) NEWFLDR:DB 0 ; Area to store newly-selected folder DELLEV: DB 0 PFLG: DB 0 ; Pass flag for renumber routine ; The following locations are used by the user sort routine NREC1: DW 0 ; Number of records NREC2: DW 0 ; Number of records again RLEN: DW 10 ; Length of one record STARR: DW 0 ; Starting address of user array I1: DW 0 ; Temporary pointer ML1: DW 0 ; Temporary pointer DJ1: DW 0 ; Temporary pointer DI1: DW 0 ; Temporary pointer ENDARR: DW 0 ; Ending address of user array IF MSGTHD FWDMSG: DW 0 ; Forward message link temp storage REVMSG: DW 0 ; Reverse message link temp storage NEWMSG: DW 0 ; New message number temp storage OLDMSG: DW 0 ; Old message number temp storage HIMSGN: DW 0 ; Old high message number storage ENDIF BAKNM: DB 'BAK' USERS2: DB 0,0,0,0,0,0,0,0,0,0,0,0,0 MSGIN2: DB 0,0,0,0,0,0,0,0,0,0,0,0,0 MESSA2: DB 0,0,0,0,0,0,0,0,0,0,0,0,0 CALRS2: DB 0,0,0,0,0,0,0,0,0,0,0,0,0 INDEX2:DB 0,0,0,0,0,0,0,0,0,0,0,0,0 RENI1: DB 0,'INDEX PBS',0,0,0,0 RENI2: DB 0,'INDEX BAK',0,0,0,0 RENU1: DB 0,'USERS PBS',0,0,0,0 RENU2: DB 0,'USERS BAK',0,0,0,0 RENM1: DB 0,'MESSAGESPBS',0,0,0,0 RENM2: DB 0,'MESSAGESBAK',0,0,0,0 RENX1: DB 0,'MSGINDEXPBS',0,0,0,0 RENX2: DB 0,'MSGINDEXBAK',0,0,0,0 RENC1: DB 0,'CALLERS ',0,0,0,0 RENC3: DB 0,'CALLERS BAK',0,0,0,0 RENC2: DB 0,'CALLERS BAK',0,0,0,0 RENC4: DB 0,'CALLERS ',0,0,0,0 ; Stack area. BSTACK EQU $ ; Bottom of stack for sort routines DS 512 ; Big stack for sort routines STACK: DW 0H CCPSTK: DW 0H ; Stack storage ENDATA EQU $-DATA MSG: DW 0 ; Holding area for messages being viewed MSGARR: DW 0 ; Array starts at address placed here after ; a call to ENDPBS in PBBSUBS.REL at START: END