home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / BBS / USEREP16.ZIP / USEREP.BAS next >
BASIC Source File  |  1992-05-03  |  10KB  |  319 lines
  1. 'Revision History
  2. '
  3. '12-AUG-88: Revision 1.0.   Initial release
  4. '21-NOV-88: Revision 1.1.   Added ability to sort via SORTF
  5. '01-JUN-89: Revision 1.2.   Changed to user defined record type to speed read
  6. '                           of PCB 14.x USERS file; dropped support of PCB 12.x
  7. '01-AUG-89: Revision 1.3.   Added alternate output file format for input to
  8. '                           database programs
  9. '02-AUG-89: Revision 1.3.1. Added visual progress tracking
  10. '09-FEB-90: Revision 1.3.2. Cosmetic changes
  11. '15-APR-92: Revision 1.4.   Added expiration date field
  12. '20-APR-92: Revision 1.5.   Redid main display screen; bug fixes
  13. '02-MAY-92: Revision 1.6.   Dealt with math problem for ratios greater than
  14. '                           3265 and CINT function.
  15. '
  16. 'Set up the constants used in the program
  17. '
  18. CONST TRUE = -1, FALSE = 0
  19. '
  20. 'Create a new record type for random access disk I/O
  21. 'Record type to read the PCB 14.x USERS file
  22. '
  23. TYPE PCB
  24.    NAM AS STRING * 25
  25.    CITY AS STRING * 24
  26.    PASS AS STRING * 12
  27.    BPHONE AS STRING * 13
  28.    HPHONE AS STRING * 13
  29.    LDATE AS STRING * 6
  30.    LTIME AS STRING * 5
  31.    EXPERT AS STRING * 1
  32.    PROT AS STRING * 1
  33.    JUNK1 AS STRING * 1
  34.    LDIR AS STRING * 6
  35.    SEC AS STRING * 1
  36.    NTIMES AS INTEGER
  37.    PLEN AS STRING * 1
  38.    UPL AS INTEGER
  39.    DOW AS INTEGER
  40.    DDOW AS STRING * 8
  41.    UCMT AS STRING * 30
  42.    SCMT AS STRING * 30
  43.    ETIME AS INTEGER
  44.    EXPT AS STRING * 6
  45.    SEXPSEC AS STRING * 1
  46.    AREA AS STRING * 1
  47.    JUNK2 AS STRING * 15
  48.    TBDOW AS STRING * 8
  49.    TBUPL AS STRING * 8
  50.    DELETE AS STRING * 1
  51.    LMSG AS STRING * 4
  52.    JUNK3 AS STRING * 171
  53. END TYPE
  54. '
  55. 'Mainline code
  56. '
  57. CLS
  58. PRINT "USEREP - PCBoard 14.x User File Report Generator, Version 1.6"
  59. PRINT "Copyright (C) 1988 - 1992, S. David Klein"
  60. PRINT " "
  61. ON ERROR GOTO ERHERE
  62. DIM ARG$(10)
  63. FL$ = "1"
  64. OPEN "I", 1, "USEREP.CFG"
  65. INPUT #1, US$
  66. US$ = UCASE$(US$)
  67. INPUT #1, REP$
  68. REP$ = UCASE$(REP$)
  69. INPUT #1, FTYP$
  70. FTYP$ = UCASE$(FTYP$)
  71. CLOSE #1
  72. PRINT "Reading USERS file:     "; US$
  73. PRINT "Writing report to file: "; REP$
  74. PRINT " "
  75. FL$ = "2"
  76. PRINT "Beginning initial scan of USERS file..."
  77. PRINT
  78. OPEN US$ FOR INPUT ACCESS READ SHARED AS #1
  79. CLOSE #1
  80. FL$ = "3"
  81. KILL REP$
  82. MAIN:
  83. DIM USR AS PCB
  84. OPEN US$ FOR RANDOM ACCESS READ SHARED AS #1 LEN = 400
  85. NREC = LOF(1) / 400
  86. OPEN "O", 2, "REPORT.$$$"
  87. I = 0
  88. PRINT "Processing user record #";
  89. REP:
  90. I = I + 1
  91. IF I > NREC GOTO FINIS1
  92. GET #1, I, USR
  93. LOCATE , 25
  94. PRINT I;
  95. IF USR.UPL = 0 THEN R = USR.DOW ELSE R = USR.DOW / USR.UPL
  96. SELECT CASE FTYP$
  97.    CASE "C"
  98.       PRINT #2, RTRIM$(USR.NAM); ",";
  99.       PRINT #2, MID$(USR.LDATE, 3, 2) + "-" + RIGHT$(USR.LDATE, 2) + "-" + LEFT$(USR.LDATE, 2); ",";
  100.       PRINT #2, MID$(USR.EXPT, 3, 2) + "-" + RIGHT$(USR.EXPT, 2) + "-" + LEFT$(USR.EXPT, 2); ",";
  101.       PRINT #2, LTRIM$(STR$(ASC(USR.SEC))); ",";
  102.       PRINT #2, LTRIM$(STR$(USR.NTIMES)); ",";
  103.       PRINT #2, LTRIM$(STR$(CVSMBF(USR.LMSG))); ",";
  104.       PRINT #2, LTRIM$(STR$(USR.UPL)); ",";
  105.       PRINT #2, LTRIM$(STR$(USR.DOW)); ",";
  106.       IF R < 1000 THEN PRINT #2, LTRIM$(STR$((CINT(R * 10)) / 10)) ELSE PRINT #2, LTRIM$(STR$(CINT(R)))
  107.    CASE "M"
  108.       PRINT #2, CHR$(34); RTRIM$(USR.NAM); CHR$(34); ",";
  109.       PRINT #2, CHR$(34); MID$(USR.LDATE, 3, 2) + "-" + RIGHT$(USR.LDATE, 2) + "-" + LEFT$(USR.LDATE, 2); CHR$(34); ",";
  110.       PRINT #2, CHR$(34); MID$(USR.EXPT, 3, 2) + "-" + RIGHT$(USR.EXPT, 2) + "-" + LEFT$(USR.EXPT, 2); CHR$(34); ",";
  111.       PRINT #2, CHR$(34); LTRIM$(STR$(ASC(USR.SEC))); CHR$(34); ",";
  112.       PRINT #2, CHR$(34); LTRIM$(STR$(USR.NTIMES)); CHR$(34); ",";
  113.       PRINT #2, CHR$(34); LTRIM$(STR$(CVSMBF(USR.LMSG))); CHR$(34); ",";
  114.       PRINT #2, CHR$(34); LTRIM$(STR$(USR.UPL)); CHR$(34); ",";
  115.       PRINT #2, CHR$(34); LTRIM$(STR$(USR.DOW)); CHR$(34); ",";
  116.       IF R < 1000 THEN PRINT #2, CHR$(34); LTRIM$(STR$((CINT(R * 10)) / 10)); CHR$(34) ELSE PRINT #2, CHR$(34); LTRIM$(STR$(CINT(R))); CHR$(34)
  117.    CASE ELSE
  118.       PRINT #2, USR.NAM; "│";
  119.       PRINT #2, TAB(27); MID$(USR.LDATE, 3, 2) + "-" + RIGHT$(USR.LDATE, 2) + "-" + LEFT$(USR.LDATE, 2); "│";
  120.       PRINT #2, TAB(36); MID$(USR.EXPT, 3, 2) + "-" + RIGHT$(USR.EXPT, 2) + "-" + LEFT$(USR.EXPT, 2); "│";
  121.       PRINT #2, TAB(45); USING "###"; ASC(USR.SEC);
  122.       PRINT #2, "│";
  123.       PRINT #2, TAB(51); USING "####"; USR.NTIMES;
  124.       PRINT #2, "│";
  125.       PRINT #2, TAB(57); USING "######"; CVSMBF(USR.LMSG);
  126.       PRINT #2, "│";
  127.       PRINT #2, TAB(64); USING "####"; USR.UPL;
  128.       PRINT #2, "│";
  129.       PRINT #2, TAB(69); USING "####"; USR.DOW;
  130.       PRINT #2, "│";
  131.       PRINT #2, TAB(74); USING "###.#"; R
  132. END SELECT
  133. GOTO REP
  134. FINIS1:
  135. CLOSE #1
  136. CLOSE #2
  137. PRINT " "
  138. PRINT "Initial scan of USERS file completed."
  139. PRINT " "
  140. IF FTYP$ = "C" OR FTYP$ = "M" THEN GOTO SKIP
  141. CMDLIN$ = COMMAND$
  142. IN = FALSE
  143. NUMARG = 0
  144.    FOR I = 1 TO LEN(CMDLIN$)
  145.       C$ = MID$(CMDLIN$, I, 1)
  146.          IF (C$ <> " " AND C$ <> CHR$(9)) THEN
  147.             IF NOT IN THEN
  148.                NUMARG = NUMARG + 1
  149.                IF NUMARG > 3 THEN EXIT FOR
  150.                IN = TRUE
  151.             END IF
  152.             ARG$(NUMARG) = C$
  153.          ELSE
  154.             IN = FALSE
  155.          END IF
  156.    NEXT I
  157.    IF ARG$(1) <> "" THEN
  158.       SK$ = UCASE$(ARG$(1))
  159.       GOTO PART1
  160.    END IF
  161. PRINT "You can sort by two of eight categories: 1) Last Date On"
  162. PRINT "                                         2) Expiration Date"
  163. PRINT "                                         3) Security"
  164. PRINT "                                         4) # Times On"
  165. PRINT "                                         5) Last Msg. Read"
  166. PRINT "                                         6) # Uploads"
  167. PRINT "                                         7) # Downloads"
  168. PRINT "                                         8) Ratio of DL/UL"
  169. PRINT "Or you can choose not to sort."
  170. PRINT "Enter the primary sort key (1 - 8) or N for no sort: ";
  171. SK$ = UCASE$(INPUT$(1))
  172. PRINT SK$
  173. PART1:
  174.    IF SK$ = "N" THEN
  175.       NAME "REPORT.$$$" AS "REPORT.$$1"
  176.       GOTO SKIP
  177.    END IF
  178.    IF ARG$(2) <> "" THEN
  179.       SL$ = UCASE$(ARG$(2))
  180.       GOTO PASS
  181.    END IF
  182. PRINT "Enter the secondary sort key (1 - 8) or N for no secondary key: ";
  183. SL$ = UCASE$(INPUT$(1))
  184. PRINT SL$
  185. PASS:
  186.    IF SL$ = SK$ THEN
  187.       PRINT "The sort keys cannot be identical.  Skipping secondary key"
  188.       SL$ = "N"
  189.    END IF
  190.    IF ARG$(3) <> "" THEN
  191.       SM$ = UCASE$(ARG$(3))
  192.       GOTO PASS1
  193.    END IF
  194. PRINT "Ascending sort is default.  Type  D  if you want descending sort: ";
  195. SM$ = UCASE$(INPUT$(1))
  196. PRINT SM$
  197. PASS1:
  198. SELECT CASE SK$
  199.    CASE "1"
  200.       SS1$ = " /+33,2 /+27,2 /+30,2"
  201.    CASE "2"
  202.       SS1$ = " /+42,2 /+36,2 /+39,2"
  203.    CASE "3"
  204.       SS1$ = " /+45,3"
  205.    CASE "4"
  206.       SS1$ = " /+49,6"
  207.    CASE "5"
  208.       SS1$ = " /+56,7"
  209.    CASE "6"
  210.       SS1$ = " /+64,4"
  211.    CASE "7"
  212.       SS1$ = " /+69,4"
  213.    CASE "8"
  214.       SS1$ = " /+74,5"
  215.    CASE ELSE
  216.       PRINT "Your primary key is invalid.  Skipping sort."
  217.       NAME "REPORT.$$$" AS "REPORT.$$1"
  218.       GOTO SKIP
  219. END SELECT
  220. SELECT CASE SL$
  221.    CASE "1"
  222.       SS2$ = " /+33,2 /+27,2 /+30,2"
  223.    CASE "1"
  224.       SS2$ = " /+42,2 /+36,2 /+39,2"
  225.    CASE "3"
  226.       SS2$ = " /+45,3"
  227.    CASE "4"
  228.       SS2$ = " /+49,6"
  229.    CASE "5"
  230.       SS2$ = " /+56,7"
  231.    CASE "6"
  232.       SS2$ = " /+64,4"
  233.    CASE "7"
  234.       SS2$ = " /+69,4"
  235.    CASE "8"
  236.       SS2$ = " /+74,5"
  237.    CASE "N"
  238.       SS2$ = " "
  239.    CASE ELSE
  240.       PRINT "Your secondary key is invalid.  Using primary key only."
  241.       SS2$ = " "
  242. END SELECT
  243. IF SM$ = "D" THEN SS3$ = " /R" ELSE SS3$ = " "
  244. PRINT " "
  245. PRINT "Shelling to SORTF..."
  246. COMLIN$ = "SORTF REPORT.$$$ REPORT.$$1 " + SS1$ + SS2$ + SS3$ + " /Q"
  247. SHELL COMLIN$
  248. KILL "REPORT.$$$"
  249. SKIP:
  250. PRINT "Beginning final report generation...";
  251.    IF FTYP$ = "C" OR FTYP$ = "M" THEN
  252.       NAME "REPORT.$$$" AS REP$
  253.       GOTO FINIS
  254.    END IF
  255. OPEN "O", 1, REP$
  256. PRINT #1, "─────────────────────────┬────────┬────────┬───┬──────┬───────┬────┬────┬─────"
  257. PRINT #1, "NAME                     │LST DATE│  EXP   │SEC│ TIMES│LST MSG│# UP│# DN│RATIO"
  258. PRINT #1, "                         │ ON SYS │  DATE  │LEV│  ON  │ READ  │LOAD│LOAD│DL/UL"
  259. PRINT #1, "─────────────────────────┼────────┼────────┼───┼──────┼───────┼────┼────┼─────"
  260. OPEN "I", 2, "REPORT.$$1"
  261. FOR I = 1 TO NREC
  262. IF FIX(I / 25) = I / 25 THEN PRINT ".";
  263. LINE INPUT #2, A$
  264. PRINT #1, A$
  265. NEXT I
  266. CLOSE #1
  267. CLOSE #2
  268. KILL "REPORT.$$1"
  269. FINIS:
  270. PRINT
  271. PRINT "Program run completed."
  272. END
  273. ERHERE:
  274. SELECT CASE FL$
  275.    CASE "1"
  276.       IF ERR = 52 OR ERR = 53 THEN
  277.          PRINT "ERR-F, Fatal Error: File Not Found"
  278.          PRINT " "
  279.          PRINT "Make sure the configuration file, USEREP.CFG, exists in"
  280.          PRINT "   the current directory."
  281.          PRINT "Program execution halting."
  282.          RESUME FINIS
  283.       END IF
  284.    CASE "2"
  285.       IF ERR = 52 OR ERR = 53 THEN
  286.          PRINT "ERR-F, Fatal Error: File Not Found"
  287.          PRINT " "
  288.          PRINT "The USERS file specified in USEREP.CFG does not exist."
  289.          PRINT "Edit USEREP.CFG so that your USERS file is specified on line 2."
  290.          PRINT "Program execution halting."
  291.          RESUME FINIS
  292.       END IF
  293.    CASE "3"
  294.       IF ERR = 52 OR ERR = 53 THEN RESUME MAIN
  295. END SELECT
  296.    END
  297.    IF ERR = 62 THEN
  298.       PRINT "ERR-F, Fatal Error - Attempt to read past end of file"
  299.       PRINT " "
  300.       PRINT "The configuration file, USEREP.CFG, is incomplete."
  301.       PRINT "Edit USEREP.CFG to ensure that it has the required 3 lines."
  302.       PRINT "Program execution halting."
  303.       RESUME FINIS
  304.    END IF
  305.    IF ERR = 64 THEN
  306.       PRINT "ERR-F, Fatal Error - Bad File Name"
  307.       PRINT " "
  308.       PRINT "One of the file names specified in USEREP.CFG is invalid."
  309.       PRINT "Change that name to a valid DOS file name."
  310.       PRINT "Program execution halting."
  311.       RESUME FINIS
  312.    END IF
  313. PRINT "ERR-F, Fatal Error - Unspecified error encountered"
  314. PRINT " "
  315. PRINT "Error code = "; ERR
  316. PRINT "Program execution halting."
  317. RESUME FINIS
  318.  
  319.