'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.
'
'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.6"
PRINT "Copyright (C) 1989, 1990, 1991, 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 2) AS FON
DIM SEP AS STARS
DIM HED AS HEAD
HED.CRL = CRLF$
SEP.STAR = STRING$(78, "*")
SEP.CRL = CRLF$
'
'Dimension static 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)
      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)
      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 4 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