'
' ┌──────────────────────────────────────────────────────────┐
' │BANKPACK.PPE - Written by Dan Shore │
' │ │
' │Purpose: Delete and remove users from BANK Database │
' │ │
' └──────────────────────────────────────────────────────────┘
' To install:
'
' 1) Edit your CMD.LST file(s) to add this:
'
' Charges Per PPE/MNU File Specification -or-
' Command Sec Minute Use Keystroke Substitution
' ══════════════ ═══ ═════════════════ ═════════════════════════════════
' 1) BANKPACK 110 0 0 C:\PCB\PPE\BANK\BANKPACK.PPE
'
' Note: You may have to change the pathname to the PPE.
' Note: You may have to change the security level of the PPE.
'
'
' *** Make sure you have BANKEDIT, BANKPACK, BANK2 & BANK
' all in the SAME directory!!!!!
'──────────────────────────────────────────────────────────────────────────────
'
' Declare our variables
'
STRING name_hold ' String to hold username
STRING ndx_path ' Path to NDX files
STRING first_letter ' First letter of username
STRING ndx_file ' Name of NDX file
STRING ndx_user_name ' Name retrieved from ndx file
STRING hold ' Generic string var
STRING bank_txt ' Text file for all user prompts
LONG ndx_size ' Size of NDX file
LONG seek_record ' How far to seek in NDX file
FLOAT high_num ' High number from NDX file
FLOAT low_num ' Low Number from NDX file
FLOAT rec_num ' Current record number in NDX file
INT x ' Generic INT
INT user_rec_num ' Record number of user
INT current_record ' Which record number we are at
INT high_record ' High record number
INT low_record ' Low record number
INT y ' Generic INT
INT deleted_users ' How many deleted users
BOOLEAN name_found ' Flag for when we find a username in PCB
;--------------------------------------------------------------------------
:START_MAIN
'
' Define external text file - Support Language Files
'
bank_txt = PPEPATH() + "BANKTXT2" + LANGEXT()
CLS
DISPFILE PPEPATH() + "packmenu", GRAPH+LANG+SEC
ANSIPOS 34, 4
PRINT READLINE(bank_txt, 66)
GOSUB READ_CONFIG
ANSIPOS 34, 4
PRINT READLINE(bank_txt, 67)
ANSIPOS 49,5
PRINT READLINE(bank_txt, 66)
GOSUB MAKE_BACKUP_FILES
ANSIPOS 49, 5
PRINT READLINE(bank_txt, 67)
ANSIPOS 40, 6
PRINT READLINE(bank_txt, 66)
GOSUB OPEN_DATABASE
IF (DERR(0)) THEN
ANSIPOS 1,15
PRINT READLINE(bank_txt, 68)
LOG READLINE(bank_txt, 69), FALSE
DELAY 36
GOTO EXIT_PROG
END IF
GOSUB OPEN_INDEX
IF (DERR(0)) THEN
ANSIPOS 1, 15
PRINT READLINE(bank_txt, 70)
LOG READLINE(bank_txt, 71), FALSE
DELAY 36
GOTO EXIT_PROG
END IF
ANSIPOS 40, 6
PRINT READLINE(bank_txt, 67)
GOSUB CHECK_NAMES
ANSIPOS 39, 8
PRINT READLINE(bank_txt, 72)
ANSIPOS 3,10
IF (deleted_users > 0) THEN
PRINT READLINE(bank_txt, 73)
DTOP 0
DPACK 0
ANSIPOS 28, 10
PRINT READLINE(bank_txt, 72)
ELSE
PRINT READLINE(bank_txt, 74)
END IF
FPUTLN 2, READLINE(bank_txt, 75), DRECCOUNT(0)
FPUTLN 2
FPUTLN 2, READLINE(bank_txt, 76), deleted_users
FPUTLN 2, READLINE(bank_txt, 77), TIME()
FCLOSE 2
ANSIPOS 33, 11
PRINT READLINE(bank_txt, 67)
GOTO EXIT_PROG
END
;
; Get each name from INDEX and check to see if user exists in
; PCB user index record. If not, flag user for deletion.
;
:CHECK_NAMES
DTOP 0
ANSIPOS 39, 8
PRINT "@X0FStarted"
FAPPEND 2, PPEPATH()+PPENAME()+".log", O_WR, S_DN
FPUTLN 2
FPUTLN 2
FPUTLN 2, "========================================================================"
FPUTLN 2
FPUTLN 2, "Bank Packing Program - Version 1.00"
FPUTLN 2, "Written by Dan Shore - SysOp - The Shoreline BBS"
FPUTLN 2
FPUTLN 2, READLINE(bank_txt, 78), DATE()
FPUTLN 2, READLINE(bank_txt, 79), TIME()
FPUTLN 2
'
' For loop to process each user record in the database
'
FOR x = 1 TO DRECCOUNT(0)
STARTDISP FNS
DGO 0, x
name_hold = DGET (0,DNAME(0,1))
first_letter = LEFT(name_hold,1)
IF (first_letter < "A") first_letter = "A"
IF (first_letter > "Z") first_letter = "Z"
FPUT 2, READLINE(bank_txt, 80), name_hold
ANSIPOS 28,9
PRINT x
IF (DDELETED(0)) THEN
INC deleted_users
ANSIPOS 61, 9
PRINT "@X0E", deleted_users
FPUTLN 2, READLINE(bank_txt, 81)
CONTINUE
END IF
'
' If user has no bank balances, purge them. If user has
' balances, then check to see if they exist in the PCB
' user indexes
'
IF (DGET (0,DNAME(0,2)) != 0 || DGET (0,DNAME(0,3)) != 0) THEN
GOSUB PCB_INDEX_SEARCH
IF (!name_found) THEN
FPUTLN 2, READLINE(bank_txt, 82)
DDELETE 0
INC deleted_users
ANSIPOS 61, 9
PRINT "@X0E", deleted_users
ELSE
FPUTLN 2, READLINE(bank_txt, 83)
END IF
ELSE
FPUTLN 2, READLINE(bank_txt, 84)
DDELETE 0
INC deleted_users
ANSIPOS 61, 9
PRINT "@X0E", deleted_users
END IF
NEXT
PRINTLN "@X07"
FPUTLN 2
FPUTLN 2, READLINE(bank_txt, 85), DRECCOUNT(0)
STARTDISP FCL
RETURN
;
; Search PCB User index file for username.
;
:PCB_INDEX_SEARCH
ndx_file = ndx_path + "PCBNDX." + first_letter
ndx_size = FILEINF(ndx_file, 4)
IF (ndx_size < 27) THEN
PRINTLN "@X03File ", ndx_file, "@X03 < 27 bytes - name not processed"
RETURN
END IF
name_found = FALSE
high_record = ndx_size/27
low_record = 0
FOPEN 1, ndx_file, O_RD, S_DN
'
' Binary search to find user in NDX files
'
WHILE (1) DO
high_num = high_record
low_num = low_record
high_num = high_num/2
low_num = low_num/2
rec_num = high_num + low_num + .5
current_record = rec_num
seek_record = (current_record-1) * 27
FSEEK 1, seek_record, SEEK_SET
FREAD 1, user_rec_num, 2
FREAD 1, ndx_user_name, 25
IF (ndx_user_name = name_hold) THEN
name_found = TRUE
BREAK
ELSE IF (high_record - low_record < 2) THEN
BREAK
ELSE IF (ndx_user_name < name_hold) THEN
low_record = current_record
ELSE IF (ndx_user_name > name_hold) THEN
high_record = current_record
END IF
END WHILE
FCLOSE 1
RETURN
;
; Make Backup files of database and index files
;
:MAKE_BACKUP_FILES
COPY PPEPATH()+"BANK.DBF", PPEPATH()+"BANK.DBK"
COPY PPEPATH()+"BANK.NDX", PPEPATH()+"BANK.NBK"
RETURN
;
; Open configuration file and read
; to find the path to the PCBNDX.? files
;
:READ_CONFIG
FOPEN 1, PPEPATH()+PPENAME()+".cfg",O_RD,S_DN
WHILE (1) DO
FGET 1, hold
IF (FERR(1)) BREAK
IF (LEFT(hold,1) = "'") CONTINUE
ndx_path = hold
ndx_path = TRIM (ndx_path," ")
IF (RIGHT(ndx_path,1) != "\") ndx_path = ndx_path + "\"
END WHILE
FCLOSE 1
RETURN
'
' Close the index file, the database file, and exit program
'
:EXIT_PROG
DNCLOSEALL 0
DCLOSE 0
ANSIPOS 26, 12
PRINT "@X03Done"
ANSIPOS 1, 16
END
'
' Subroutine to open/create database files
'
:OPEN_DATABASE
DOPEN 0, PPEPATH()+"BANK", TRUE
RETURN
'
' Subroutine to open the username index file
'
:OPEN_INDEX
IF (EXIST(PPEPATH()+"BANK.NDX")) DNOPEN 0, PPEPATH()+"BANK"
RETURN
