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 >
BASIC Source File  |  1992-12-08  |  12KB  |  439 lines
  1. 'Revision History
  2. '
  3. '18-DEC-88: Revision 1.0.   Initial release
  4. '15-APR-89: Revision 1.1.   Changed to random access file I/O and user defined
  5. '                             record types to speed-up the program; added rerun
  6. '                             question for speed in checking all types.
  7. '01-AUG-89: Revision 1.2.   USEREP and FONREP now share common data types.
  8. '02-AUG-89: Revision 1.2.1. Custom version
  9. '02-AUG-89: Revision 1.2.2. Added visual progress tracking in sort phase.
  10. '22-NOV-89: Revision 1.3.   Rewrite to add comparison of all phone numbers
  11. '                             including Caller-ID, if available, and create a
  12. '                             master list of all numbers; streamline code.
  13. '08-MAR-90: Revision 1.4.   Include a supplemental users listing, if desired.
  14. '15-MAY-91: Revision 1.5.   Include security level in both reports.  Allow
  15. '                             multiple Caller*ID number entries in sysop comment.
  16. '                             Include last date on in master listing.
  17. '01-JUL-91: Revision 1.6.   Allow use of QSort for large USERS files, where
  18. '                             SORTF runs out of RAM.
  19. '10-AUG-91: Revision 1.7.   Corrected error associated with use of QSort.
  20. '08-DEC-92: Revision 1.8.   Redid report so that like members are clustered in
  21. '                             groups of more than two.
  22. '
  23. 'Specify the arrays for dynamic storage
  24. '
  25. REM $DYNAMIC
  26. '
  27. 'Create five new record types for random access disk I/O
  28. 'The first to read and write the report files
  29. '
  30. TYPE REP
  31.    NAM AS STRING * 25
  32.    SEC AS STRING * 5
  33.    PHO AS STRING * 26
  34.    PAS AS STRING * 14
  35.    DAT AS STRING * 8
  36.    CRL AS STRING * 2
  37. END TYPE
  38. '
  39. 'The second to read the master list
  40. '
  41. TYPE FON
  42.    NAM AS STRING * 25
  43.    SEC AS STRING * 5
  44.    PHO AS STRING * 12
  45.    TYP AS STRING * 14
  46.    PAS AS STRING * 14
  47.    DAT AS STRING * 8
  48.    CRL AS STRING * 2
  49. END TYPE
  50. '
  51. 'The third for the item separator
  52. '
  53. TYPE STARS
  54.    STAR AS STRING * 78
  55.    CRL AS STRING * 2
  56. END TYPE
  57. '
  58. 'The fourth as the item header
  59. '
  60. TYPE HEAD
  61.    HEADER AS STRING * 78
  62.    CRL AS STRING * 2
  63. END TYPE
  64. '
  65. 'The fifth to read the PCB 14.0 USERS file
  66. '
  67. TYPE PCB
  68.    NAM AS STRING * 25
  69.    CITY AS STRING * 24
  70.    PASS AS STRING * 12
  71.    BPHONE AS STRING * 13
  72.    HPHONE AS STRING * 13
  73.    LDATE AS STRING * 6
  74.    LTIME AS STRING * 5
  75.    EXPERT AS STRING * 1
  76.    PROT AS STRING * 1
  77.    JUNK1 AS STRING * 1
  78.    LDIR AS STRING * 6
  79.    SEC AS STRING * 1
  80.    NTIMES AS INTEGER
  81.    PLEN AS STRING * 1
  82.    UPL AS INTEGER
  83.    DOW AS INTEGER
  84.    DDOW AS STRING * 8
  85.    UCMT AS STRING * 30
  86.    SCMT AS STRING * 30
  87.    ETIME AS INTEGER
  88.    EXPT AS STRING * 6
  89.    SEXPSEC AS STRING * 1
  90.    AREA AS STRING * 1
  91.    JUNK2 AS STRING * 15
  92.    TBDOW AS STRING * 8
  93.    TBUPL AS STRING * 8
  94.    DELETE AS STRING * 1
  95.    LMSG AS STRING * 4
  96.    JUNK3 AS STRING * 171
  97. END TYPE
  98. '
  99. 'Beginning of executable code
  100. '
  101. CLS
  102. '
  103. 'Set up the error handler
  104. '
  105. ON ERROR GOTO ERHERE
  106. '
  107. 'Print the greeting
  108. '
  109. PRINT "FONREP - PCBoard 14.x User File Phone Number Comparator, Version 1.8"
  110. PRINT "Copyright (C) 1989 - 1992, S. David Klein"
  111. PRINT " "
  112. '
  113. 'Set up the records with the defined record types
  114. '
  115. CRLF$ = CHR$(13) + CHR$(10)
  116. DIM RA AS PCB
  117. DIM WA AS REP
  118. DIM TA AS REP
  119. DIM XA AS REP
  120. DIM MA AS REP
  121. DIM RES(1 TO 2) AS FON
  122. DIM REC(1 TO 1000) AS FON
  123. DIM SEP AS STARS
  124. DIM HED AS HEAD
  125. HED.CRL = CRLF$
  126. SEP.STAR = STRING$(78, "*")
  127. SEP.CRL = CRLF$
  128. '
  129. 'Dimension arrays and set up constants
  130. '
  131. DIM T$(5)
  132. T$(1) = "("
  133. T$(2) = ")"
  134. T$(3) = "-"
  135. T$(4) = "/"
  136. T$(5) = " "
  137. '
  138. 'FL$ is the file open flag; if we have an open error, tells which file
  139. '
  140. FL$ = "1"
  141. '
  142. 'Open the config file, read the information
  143. '
  144. OPEN "I", 1, "FONREP.CFG"
  145. INPUT #1, US$
  146. INPUT #1, LIS$
  147. INPUT #1, REP$
  148. INPUT #1, FON$
  149. INPUT #1, SOR$
  150. INPUT #1, SUP$
  151. IF UCASE$(SUP$) = "Y" THEN INPUT #1, FIL$
  152. CLOSE #1
  153. IF UCASE$(SOR$) = "Q" OR UCASE$(SOR$) = "S" THEN GOTO CON0
  154. PRINT "Your config file does not properly specify the use of SORTF or QSORT."
  155. PRINT "Please redo the config file and run the program again."
  156. GOTO FINIS
  157. CON0:
  158. IF UCASE$(SOR$) = "Q" THEN SNAM$ = "QSORT" ELSE SNAM$ = "SORTF"
  159. PRINT "Reading USERS file:      "; US$
  160. PRINT "Writing report to file:  "; REP$
  161. PRINT "Writing listing to file: "; LIS$
  162. PRINT "Using sort program:      "; SNAM$
  163. PRINT " "
  164.  
  165. '
  166. 'If we get an open error now, it's the specified USERS file
  167. '
  168. FL$ = "2"
  169. OPEN US$ FOR RANDOM ACCESS READ SHARED AS #1 LEN = 400
  170. OPEN "REPORT.$$$" FOR RANDOM AS #2 LEN = 80
  171. '
  172. 'For random access file, # of records = length of file / record length
  173. 'Get the number of records in the USERS file
  174. '
  175. NREC = LOF(1) / 400
  176. '
  177. 'Start reading the USERS file
  178. '
  179. I = 0
  180. JJ = -1
  181. PRINT "Processing user record #";
  182. REP:
  183. I = I + 1
  184. JJ = JJ + 2
  185. IF I > NREC GOTO CONT
  186. GET #1, I, RA
  187. WA.NAM = RA.NAM
  188. WA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
  189. WA.PAS = RA.PASS
  190. WA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
  191. WA.CRL = CRLF$
  192. TA.NAM = RA.NAM
  193. TA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
  194. TA.PAS = RA.PASS
  195. TA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
  196. TA.CRL = CRLF$
  197. LOCATE , 25
  198. PRINT I;
  199. K$ = LTRIM$(RTRIM$(RA.BPHONE))
  200. L = LEN(K$)
  201. GOSUB FILTER
  202. WA.PHO = P$ + " - BUS"
  203. K$ = LTRIM$(RTRIM$(RA.HPHONE))
  204. L = LEN(K$)
  205. GOSUB FILTER
  206. TA.PHO = P$ + " - HOM"
  207. PUT #2, JJ, WA
  208. PUT #2, JJ + 1, TA
  209. IF LEFT$(RA.SCMT, 3) = "CI:" THEN
  210.    XA.NAM = RA.NAM
  211.    XA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
  212.    XA.PAS = RA.PASS
  213.    XA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
  214.    XA.CRL = CRLF$
  215.    K$ = MID$(RA.SCMT, 4, 12)
  216.    L = LEN(K$)
  217.    GOSUB FILTER
  218.    XA.PHO = P$ + " - ID"
  219.    PUT #2, JJ + 2, XA
  220.    JJ = JJ + 1
  221.    IF MID$(RA.SCMT, 16, 1) = ";" THEN
  222.       MA.NAM = RA.NAM
  223.       MA.SEC = LTRIM$(STR$(ASC(RA.SEC)))
  224.       MA.PAS = RA.PASS
  225.       MA.DAT = MID$(RA.LDATE, 3, 2) + "-" + RIGHT$(RA.LDATE, 2) + "-" + LEFT$(RA.LDATE, 2)
  226.       MA.CRL = CRLF$
  227.       K$ = MID$(RA.SCMT, 17, 12)
  228.       L = LEN(K$)
  229.       GOSUB FILTER
  230.       MA.PHO = P$ + " - ID"
  231.       PUT #2, JJ + 2, MA
  232.       JJ = JJ + 1
  233.    END IF
  234. END IF
  235. GOTO REP
  236. CONT:
  237. PRINT
  238. CLOSE #1
  239. CLOSE #2
  240. '
  241. 'We have a temp file of user information.  Now sort it.
  242. '
  243. IF UCASE$(SUP$) = "Y" THEN
  244.   ST$ = "COPY REPORT.$$$ + " + FIL$
  245.   SHELL ST$
  246. END IF
  247. IF UCASE$(SOR$) = "Q" THEN GOTO QS1
  248. PRINT "Shelling to SORTF..."
  249. ST$ = "SORTF REPORT.$$$ REPORT.$$1 /+31,12 /+1,25 /+46,3 /+77,2 /+71,2 /+74,2"
  250. SHELL ST$
  251. GOTO CON1
  252. QS1:
  253. PRINT "Shelling to QSORT..."
  254. ST$ = "QSORT REPORT.$$$ REPORT.$$1 /+31:12 /+1:25 /+46:3 /+77:2 /+71:2 /+74:2"
  255. SHELL ST$
  256. CON1:
  257. '
  258. 'Take the temp file and eliminate duplicate listings to create the
  259. 'master list
  260. '
  261. PRINT "Beginning duplicate weeding phase";
  262. OPEN "REPORT.$$1" FOR RANDOM AS #1 LEN = 80
  263. OPEN LIS$ FOR RANDOM AS #2 LEN = 80
  264. NREC = LOF(1) / 80
  265. FOR I = 1 TO NREC - 1
  266.    IF FIX(I / 25) = I / 25 THEN PRINT ".";
  267.    GET #1, I, RES(1)
  268.    GET #1, I + 1, RES(2)
  269.    IF NOT ((RES(1).NAM = RES(2).NAM) AND (RES(1).PHO = RES(2).PHO)) THEN PUT #2, , RES(1)
  270. NEXT I
  271. PRINT
  272. CLOSE #1
  273. CLOSE #2
  274. '
  275. 'Get rid of our temporary files
  276. '
  277. KILL "REPORT.$$$"
  278. KILL "REPORT.$$1"
  279. '
  280. 'Search the list for duplicate numbers; could be problem children
  281. '
  282. OPEN LIS$ FOR RANDOM AS #1 LEN = 80
  283. OPEN REP$ FOR RANDOM AS #2 LEN = 80
  284. NREC = LOF(1) / 80
  285. PUT #2, , SEP
  286. HED.HEADER = "Users with matching phone numbers"
  287. PUT #2, , HED
  288. PUT #2, , SEP
  289. PRINT "Comparing phone numbers";
  290. FOR I = 1 TO NREC - 1
  291.    IF FIX(I / 25) = I / 25 THEN PRINT ".";
  292.    GET #1, I, REC(1)
  293.    GET #1, I + 1, REC(2)
  294.    IF REC(1).PHO = REC(2).PHO THEN
  295.       PUT #2, , REC(1)
  296.       PUT #2, , REC(2)
  297.       I = I + 1
  298.       J = 3
  299. LOO1: GET #1, I + 1, REC(J)
  300.       IF REC(1).PHO = REC(J).PHO THEN
  301.          PUT #2, , REC(J)
  302.          J = J + 1
  303.          I = I + 1
  304.          GOTO LOO1
  305.       END IF
  306.       PUT #2, , SEP
  307.    END IF
  308. NEXT I
  309. PRINT
  310. CLOSE #1
  311. '
  312. 'Now, sort on the password field, look for matching passwords
  313. '
  314. IF UCASE$(SOR$) = "Q" THEN GOTO QS2
  315. PRINT "Shelling to SORTF..."
  316. ST$ = "SORTF " + LIS$ + " REPORT.$$$ /+52,12 /+1,25 /Q"
  317. SHELL ST$
  318. GOTO CON2
  319. QS2:
  320. PRINT "Shelling to QSORT..."
  321. ST$ = "QSORT " + LIS$ + " REPORT.$$$ /+52:12 /+1:25"
  322. SHELL ST$
  323. CON2:
  324. '
  325. 'Compare user records to find matching passwords
  326. '
  327. HED.HEADER = "Users with matching passwords"
  328. PUT #2, , HED
  329. PUT #2, , SEP
  330. OPEN "REPORT.$$$" FOR RANDOM AS #1 LEN = 80
  331. NREC = LOF(1) / 80
  332. PRINT "Comparing passwords....";
  333. FOR I = 1 TO NREC - 1
  334.    IF FIX(I / 25) = I / 25 THEN PRINT ".";
  335.    GET #1, I, REC(1)
  336.    GET #1, I + 1, REC(2)
  337.    IF (REC(1).PAS = REC(2).PAS) AND (REC(1).NAM <> REC(2).NAM) THEN
  338.       PUT #2, , REC(1)
  339.       PUT #2, , REC(2)
  340.       I = I + 1
  341.       J = 3
  342. LOO2: GET #1, I + 1, REC(J)
  343.       IF REC(J - 1).PAS = REC(J).PAS THEN
  344.          IF REC(J - 1).NAM <> REC(J).NAM THEN PUT #2, , REC(J)
  345.          J = J + 1
  346.          I = I + 1
  347.          GOTO LOO2
  348.       END IF
  349.       PUT #2, , SEP
  350.    END IF
  351. NEXT I
  352. PRINT
  353. CLOSE #1
  354. CLOSE #2
  355. KILL "REPORT.$$$"
  356. FINIS:
  357. PRINT
  358. PRINT "Program run terminated."
  359. RESET
  360. END
  361. '
  362. 'End of executable code
  363. '
  364. 'This is the error handler.  Most common errors are spelled out.  Uncommon
  365. 'errors will at least print an error code for debugging
  366. '
  367. ERHERE:
  368. SELECT CASE FL$
  369.    CASE "1"
  370.       IF ERR = 52 OR ERR = 53 THEN
  371.          PRINT "ERR-F, Fatal Error: File Not Found"
  372.          PRINT " "
  373.          PRINT "Make sure the configuration file, FONLIST.CFG, exists in"
  374.          PRINT "   the current directory."
  375.          PRINT "Program execution halting."
  376.          RESUME FINIS
  377.       END IF
  378.    CASE "2"
  379.       IF ERR = 52 OR ERR = 53 THEN
  380.          PRINT "ERR-F, Fatal Error: File Not Found"
  381.          PRINT " "
  382.          PRINT "The USERS file specified in FONLIST.CFG does not exist."
  383.          PRINT "Edit FONLIST.CFG so that your USERS file is specified on line 2."
  384.          PRINT "Program execution halting."
  385.          RESUME FINIS
  386.       END IF
  387. END SELECT
  388. IF ERR = 62 THEN
  389.    PRINT "ERR-F, Fatal Error - Attempt to read past end of file"
  390.    PRINT " "
  391.    PRINT "The configuration file, FONLIST.CFG, is incomplete."
  392.    PRINT "Edit FONLIST.CFG to ensure that it has the required number of lines."
  393.    PRINT "Program execution halting."
  394.    RESUME FINIS
  395. END IF
  396. IF ERR = 64 THEN
  397.    PRINT "ERR-F, Fatal Error - Bad File Name"
  398.    PRINT " "
  399.    PRINT "One of the file names specified in FONLIST.CFG is invalid."
  400.    PRINT "Change that name to a valid DOS file name."
  401.    PRINT "Program execution halting."
  402.    RESUME FINIS
  403. END IF
  404. PRINT "ERR-F, Fatal Error - Unspecified error encountered"
  405. PRINT " "
  406. PRINT "Error code = "; ERR
  407. PRINT "Program execution halting."
  408. RESUME FINIS
  409. '
  410. 'The filter subroutine, where we remove phone number punctuation and put the
  411. 'numbers into a standard format for later comparison
  412. '
  413. FILTER:
  414. FOR J = 1 TO 5
  415. REP1:
  416. P = INSTR(K$, T$(J))
  417.   DO WHILE P <> 0
  418.       IF P = 1 THEN
  419.          K$ = RIGHT$(K$, L - 1)
  420.       ELSE
  421.          K$ = LEFT$(K$, P - 1) + RIGHT$(K$, L - P)
  422.       END IF
  423.    L = LEN(K$)
  424.    GOTO REP1
  425.    LOOP
  426. NEXT J
  427. IF L = 0 THEN P$ = "BLANK NUMB  "
  428. IF L > 0 AND L < 7 THEN P$ = "INVALID NUMB"
  429. IF L = 7 THEN P$ = "    " + LEFT$(K$, 3) + " " + RIGHT$(K$, 4)
  430. IF L = 8 THEN P$ = "INVALID NUMB"
  431. IF L = 9 THEN P$ = "INVALID NUMB"
  432. IF L = 10 THEN P$ = LEFT$(K$, 3) + " " + MID$(K$, 4, 3) + " " + RIGHT$(K$, 4)
  433. IF L = 11 THEN P$ = K$ + " "
  434. IF L = 12 THEN P$ = K$
  435. IF L = 13 THEN P$ = LEFT$(K$, 12)
  436. IF LEN(P$) > 7 AND LEFT$(P$, 3) = FON$ THEN P$ = "   " + RIGHT$(P$, LEN(P$) - 3)
  437. RETURN
  438.  
  439.