home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.wwiv.com
/
ftp.wwiv.com.zip
/
ftp.wwiv.com
/
pub
/
BBS
/
FONREP18.ZIP
/
FONREP.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-12-08
|
12KB
|
439 lines
'Revision History
'
'18-DEC-88: Revision 1.0. Initial release
'15-APR-89: Revision 1.1. Changed to random access file I/O and user defined
' record types to speed-up the program; added rerun
' question for speed in checking all types.
'01-AUG-89: Revision 1.2. USEREP and FONREP now share common data types.
'02-AUG-89: Revision 1.2.1. Custom version
'02-AUG-89: Revision 1.2.2. Added visual progress tracking in sort phase.
'22-NOV-89: Revision 1.3. Rewrite to add comparison of all phone numbers
' including Caller-ID, if available, and create a
' master list of all numbers; streamline code.
'08-MAR-90: Revision 1.4. Include a supplemental users listing, if desired.
'15-MAY-91: Revision 1.5. Include security level in both reports. Allow
' multiple Caller*ID number entries in sysop comment.
' Include last date on in master listing.
'01-JUL-91: Revision 1.6. Allow use of QSort for large USERS files, where
' SORTF runs out of RAM.
'10-AUG-91: Revision 1.7. Corrected error associated with use of QSort.
'08-DEC-92: Revision 1.8. Redid report so that like members are clustered in
' groups of more than two.
'
'Specify the arrays for dynamic storage
'
REM $DYNAMIC
'
'Create five new record types for random access disk I/O
'The first to read and write the report files
'
TYPE REP
NAM AS STRING * 25
SEC AS STRING * 5
PHO AS STRING * 26
PAS AS STRING * 14
DAT AS STRING * 8
CRL AS STRING * 2
END TYPE
'
'The second to read the master list
'
TYPE FON
NAM AS STRING * 25
SEC AS STRING * 5
PHO AS STRING * 12
TYP AS STRING * 14
PAS AS STRING * 14
DAT AS STRING * 8
CRL AS STRING * 2
END TYPE
'
'The third for the item separator
'
TYPE STARS
STAR AS STRING * 78
CRL AS STRING * 2
END TYPE
'
'The fourth as the item header
'
TYPE HEAD
HEADER AS STRING * 78
CRL AS STRING * 2
END TYPE
'
'The fifth to read the PCB 14.0 USERS file
'
TYPE PCB
NAM AS STRING * 25
CITY AS STRING * 24
PASS AS STRING * 12
BPHONE AS STRING * 13
HPHONE AS STRING * 13
LDATE AS STRING * 6
LTIME AS STRING * 5
EXPERT AS STRING * 1
PROT AS STRING * 1
JUNK1 AS STRING * 1
LDIR AS STRING * 6
SEC AS STRING * 1
NTIMES AS INTEGER
PLEN AS STRING * 1
UPL AS INTEGER
DOW AS INTEGER
DDOW AS STRING * 8
UCMT AS STRING * 30
SCMT AS STRING * 30
ETIME AS INTEGER
EXPT AS STRING * 6
SEXPSEC AS STRING * 1
AREA AS STRING * 1
JUNK2 AS STRING * 15
TBDOW AS STRING * 8
TBUPL AS STRING * 8
DELETE AS STRING * 1
LMSG AS STRING * 4
JUNK3 AS STRING * 171
END TYPE
'
'Beginning of executable code
'
CLS
'
'Set up the error handler
'
ON ERROR GOTO ERHERE
'
'Print the greeting
'
PRINT "FONREP - PCBoard 14.x User File Phone Number Comparator, Version 1.8"
PRINT "Copyright (C) 1989 - 1992, S. David Klein"
PRINT " "
'
'Set up the records with the defined record types
'
CRLF$ = CHR$(13) + CHR$(10)
DIM RA AS PCB
DIM WA AS REP
DIM TA AS REP
DIM XA AS REP
DIM MA AS REP
DIM RES(1 TO 2) AS FON
DIM REC(1 TO 1000) AS FON
DIM SEP AS STARS
DIM HED AS HEAD
HED.CRL = CRLF$
SEP.STAR = STRING$(78, "*")
SEP.CRL = CRLF$
'
'Dimension arrays and set up constants
'
DIM T$(5)
T$(1) = "("
T$(2) = ")"
T$(3) = "-"
T$(4) = "/"
T$(5) = " "
'
'FL$ is the file open flag; if we have an open error, tells which file
'
FL$ = "1"
'
'Open the config file, read the information
'
OPEN "I", 1, "FONREP.CFG"
INPUT #1, US$
INPUT #1, LIS$
INPUT #1, REP$
INPUT #1, FON$
INPUT #1, SOR$
INPUT #1, SUP$
IF UCASE$(SUP$) = "Y" THEN INPUT #1, FIL$
CLOSE #1
IF UCASE$(SOR$) = "Q" OR UCASE$(SOR$) = "S" THEN GOTO CON0
PRINT "Your config file does not properly specify the use of SORTF or QSORT."
PRINT "Please redo the config file and run the program again."
GOTO FINIS
CON0:
IF UCASE$(SOR$) = "Q" THEN SNAM$ = "QSORT" ELSE SNAM$ = "SORTF"
PRINT "Reading USERS file: "; US$
PRINT "Writing report to file: "; REP$
PRINT "Writing listing to file: "; LIS$
PRINT "Using sort program: "; SNAM$
PRINT " "
'
'If we get an open error now, it's the specified USERS file
'
FL$ = "2"
OPEN US$ FOR RANDOM ACCESS READ SHARED AS #1 LEN = 400
OPEN "REPORT.$$$" FOR RANDOM AS #2 LEN = 80
'
'For random access file, # of records = length of file / record length
'Get the number of records in the USERS file
'
NREC = LOF(1) / 400
'
'Start reading the USERS file
'
I = 0
JJ = -1
PRINT "Processing user record #";
REP:
I = I + 1
JJ = JJ + 2
IF I > NREC GOTO CONT
GET #1, I, RA
WA.NAM = RA.NAM
WA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
WA.PAS = RA.PASS
WA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
WA.CRL = CRLF$
TA.NAM = RA.NAM
TA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
TA.PAS = RA.PASS
TA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
TA.CRL = CRLF$
LOCATE , 25
PRINT I;
K$ = LTRIM$(RTRIM$(RA.BPHONE))
L = LEN(K$)
GOSUB FILTER
WA.PHO = P$ + " - BUS"
K$ = LTRIM$(RTRIM$(RA.HPHONE))
L = LEN(K$)
GOSUB FILTER
TA.PHO = P$ + " - HOM"
PUT #2, JJ, WA
PUT #2, JJ + 1, TA
IF LEFT$(RA.SCMT, 3) = "CI:" THEN
XA.NAM = RA.NAM
XA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
XA.PAS = RA.PASS
XA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
XA.CRL = CRLF$
K$ = MID$(RA.SCMT, 4, 12)
L = LEN(K$)
GOSUB FILTER
XA.PHO = P$ + " - ID"
PUT #2, JJ + 2, XA
JJ = JJ + 1
IF MID$(RA.SCMT, 16, 1) = ";" THEN
MA.NAM = RA.NAM
MA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
MA.PAS = RA.PASS
MA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
MA.CRL = CRLF$
K$ = MID$(RA.SCMT, 17, 12)
L = LEN(K$)
GOSUB FILTER
MA.PHO = P$ + " - ID"
PUT #2, JJ + 2, MA
JJ = JJ + 1
END IF
END IF
GOTO REP
CONT:
PRINT
CLOSE #1
CLOSE #2
'
'We have a temp file of user information. Now sort it.
'
IF UCASE$(SUP$) = "Y" THEN
ST$ = "COPY REPORT.$$$ + " + FIL$
SHELL ST$
END IF
IF UCASE$(SOR$) = "Q" THEN GOTO QS1
PRINT "Shelling to SORTF..."
ST$ = "SORTF REPORT.$$$ REPORT.$$1 /+31,12 /+1,25 /+46,3 /+77,2 /+71,2 /+74,2"
SHELL ST$
GOTO CON1
QS1:
PRINT "Shelling to QSORT..."
ST$ = "QSORT REPORT.$$$ REPORT.$$1 /+31:12 /+1:25 /+46:3 /+77:2 /+71:2 /+74:2"
SHELL ST$
CON1:
'
'Take the temp file and eliminate duplicate listings to create the
'master list
'
PRINT "Beginning duplicate weeding phase";
OPEN "REPORT.$$1" FOR RANDOM AS #1 LEN = 80
OPEN LIS$ FOR RANDOM AS #2 LEN = 80
NREC = LOF(1) / 80
FOR I = 1 TO NREC - 1
IF FIX(I / 25) = I / 25 THEN PRINT ".";
GET #1, I, RES(1)
GET #1, I + 1, RES(2)
IF NOT ((RES(1).NAM = RES(2).NAM) AND (RES(1).PHO = RES(2).PHO)) THEN PUT #2, , RES(1)
NEXT I
PRINT
CLOSE #1
CLOSE #2
'
'Get rid of our temporary files
'
KILL "REPORT.$$$"
KILL "REPORT.$$1"
'
'Search the list for duplicate numbers; could be problem children
'
OPEN LIS$ FOR RANDOM AS #1 LEN = 80
OPEN REP$ FOR RANDOM AS #2 LEN = 80
NREC = LOF(1) / 80
PUT #2, , SEP
HED.HEADER = "Users with matching phone numbers"
PUT #2, , HED
PUT #2, , SEP
PRINT "Comparing phone numbers";
FOR I = 1 TO NREC - 1
IF FIX(I / 25) = I / 25 THEN PRINT ".";
GET #1, I, REC(1)
GET #1, I + 1, REC(2)
IF REC(1).PHO = REC(2).PHO THEN
PUT #2, , REC(1)
PUT #2, , REC(2)
I = I + 1
J = 3
LOO1: GET #1, I + 1, REC(J)
IF REC(1).PHO = REC(J).PHO THEN
PUT #2, , REC(J)
J = J + 1
I = I + 1
GOTO LOO1
END IF
PUT #2, , SEP
END IF
NEXT I
PRINT
CLOSE #1
'
'Now, sort on the password field, look for matching passwords
'
IF UCASE$(SOR$) = "Q" THEN GOTO QS2
PRINT "Shelling to SORTF..."
ST$ = "SORTF " + LIS$ + " REPORT.$$$ /+52,12 /+1,25 /Q"
SHELL ST$
GOTO CON2
QS2:
PRINT "Shelling to QSORT..."
ST$ = "QSORT " + LIS$ + " REPORT.$$$ /+52:12 /+1:25"
SHELL ST$
CON2:
'
'Compare user records to find matching passwords
'
HED.HEADER = "Users with matching passwords"
PUT #2, , HED
PUT #2, , SEP
OPEN "REPORT.$$$" FOR RANDOM AS #1 LEN = 80
NREC = LOF(1) / 80
PRINT "Comparing passwords....";
FOR I = 1 TO NREC - 1
IF FIX(I / 25) = I / 25 THEN PRINT ".";
GET #1, I, REC(1)
GET #1, I + 1, REC(2)
IF (REC(1).PAS = REC(2).PAS) AND (REC(1).NAM <> REC(2).NAM) THEN
PUT #2, , REC(1)
PUT #2, , REC(2)
I = I + 1
J = 3
LOO2: GET #1, I + 1, REC(J)
IF REC(J - 1).PAS = REC(J).PAS THEN
IF REC(J - 1).NAM <> REC(J).NAM THEN PUT #2, , REC(J)
J = J + 1
I = I + 1
GOTO LOO2
END IF
PUT #2, , SEP
END IF
NEXT I
PRINT
CLOSE #1
CLOSE #2
KILL "REPORT.$$$"
FINIS:
PRINT
PRINT "Program run terminated."
RESET
END
'
'End of executable code
'
'This is the error handler. Most common errors are spelled out. Uncommon
'errors will at least print an error code for debugging
'
ERHERE:
SELECT CASE FL$
CASE "1"
IF ERR = 52 OR ERR = 53 THEN
PRINT "ERR-F, Fatal Error: File Not Found"
PRINT " "
PRINT "Make sure the configuration file, FONLIST.CFG, exists in"
PRINT " the current directory."
PRINT "Program execution halting."
RESUME FINIS
END IF
CASE "2"
IF ERR = 52 OR ERR = 53 THEN
PRINT "ERR-F, Fatal Error: File Not Found"
PRINT " "
PRINT "The USERS file specified in FONLIST.CFG does not exist."
PRINT "Edit FONLIST.CFG so that your USERS file is specified on line 2."
PRINT "Program execution halting."
RESUME FINIS
END IF
END SELECT
IF ERR = 62 THEN
PRINT "ERR-F, Fatal Error - Attempt to read past end of file"
PRINT " "
PRINT "The configuration file, FONLIST.CFG, is incomplete."
PRINT "Edit FONLIST.CFG to ensure that it has the required number of lines."
PRINT "Program execution halting."
RESUME FINIS
END IF
IF ERR = 64 THEN
PRINT "ERR-F, Fatal Error - Bad File Name"
PRINT " "
PRINT "One of the file names specified in FONLIST.CFG is invalid."
PRINT "Change that name to a valid DOS file name."
PRINT "Program execution halting."
RESUME FINIS
END IF
PRINT "ERR-F, Fatal Error - Unspecified error encountered"
PRINT " "
PRINT "Error code = "; ERR
PRINT "Program execution halting."
RESUME FINIS
'
'The filter subroutine, where we remove phone number punctuation and put the
'numbers into a standard format for later comparison
'
FILTER:
FOR J = 1 TO 5
REP1:
P = INSTR(K$, T$(J))
DO WHILE P <> 0
IF P = 1 THEN
K$ = RIGHT$(K$, L - 1)
ELSE
K$ = LEFT$(K$, P - 1) + RIGHT$(K$, L - P)
END IF
L = LEN(K$)
GOTO REP1
LOOP
NEXT J
IF L = 0 THEN P$ = "BLANK NUMB "
IF L > 0 AND L < 7 THEN P$ = "INVALID NUMB"
IF L = 7 THEN P$ = " " + LEFT$(K$, 3) + " " + RIGHT$(K$, 4)
IF L = 8 THEN P$ = "INVALID NUMB"
IF L = 9 THEN P$ = "INVALID NUMB"
IF L = 10 THEN P$ = LEFT$(K$, 3) + " " + MID$(K$, 4, 3) + " " + RIGHT$(K$, 4)
IF L = 11 THEN P$ = K$ + " "
IF L = 12 THEN P$ = K$
IF L = 13 THEN P$ = LEFT$(K$, 12)
IF LEN(P$) > 7 AND LEFT$(P$, 3) = FON$ THEN P$ = " " + RIGHT$(P$, LEN(P$) - 3)
RETURN