home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RBBS_PC / REHASH11.ZIP / REHASH.BAS next >
Encoding:
BASIC Source File  |  1990-10-04  |  7.0 KB  |  251 lines
  1. DECLARE FUNCTION HashTo% (V$, MaxPos%)
  2. DECLARE FUNCTION ValidUser% (U$)
  3.  
  4. '*  REHASH.BAS
  5. '*---------------------------------------------------------------------------
  6. '*
  7. '*  Quick 'N Dirty utility to auto-size/pack a RBBS users file
  8. '*
  9. '*  10-04-90
  10. '*
  11.  
  12.       ON ERROR GOTO 999
  13.       DEFINT A-Z
  14.  
  15.       CONST FALSE = 0
  16.       CONST TRUE = -1
  17.  
  18.       OPEN "CONS:" FOR OUTPUT AS #10
  19.  
  20.       PRINT #10, "REHASH v1.10 10-04-90, Super-Dooper RBBS Users File Resizer, by Tom Collins"
  21.       PRINT #10,
  22.  
  23.       A$ = COMMAND$
  24.       A$ = UCASE$(LTRIM$(RTRIM$(A$)))
  25.  
  26.       ExemptLevel = 32000
  27.       I = INSTR(A$, "/EL")
  28.       IF I <> 0 THEN
  29.          ExemptLevel = VAL(MID$(A$, I + 3))
  30.       END IF
  31.       OlderThan = 32000
  32.       I = INSTR(A$, "/OT")
  33.       IF I <> 0 THEN
  34.          OlderThan = VAL(MID$(A$, I + 3))
  35.       END IF
  36.       ExtraUsers = 0
  37.       MultiplyFactor! = 1!
  38.       I = INSTR(A$, "/MF")
  39.       IF I <> 0 THEN
  40.          MultiplyFactor! = VAL(MID$(A$, I + 3))
  41.          IF MultiplyFactor! < 1! OR MultiplyFactor! > 10! THEN
  42.             MultiplyFactor! = 1!
  43.          END IF
  44.       END IF
  45.       IF MultiplyFactor! = 1! THEN
  46.          ExtraUsers = 8
  47.       END IF
  48.       I = INSTR(A$, "/EU")
  49.       IF I <> 0 THEN
  50.          X = VAL(MID$(A$, I + 3))
  51.          IF X > 0 THEN
  52.             ExtraUsers = X
  53.          END IF
  54.       END IF
  55.       I = INSTR(A$, "/")
  56.       IF I <> 0 THEN
  57.          A$ = LEFT$(A$, I - 1)
  58.       END IF
  59.       I = INSTR(A$, " ")
  60.       IF A$ = "" OR I = 0 THEN
  61.          PRINT #10, "Usage: REHASH <Messages File> <Users File> [/ELx] [/OTx] [/MFx] [/EUx]"
  62.          PRINT #10, "       /ELx   - Users >= Level x are exempt from packing"
  63.          PRINT #10, "       /OTx   - Remove users who haven't been on in x days"
  64.          PRINT #10, "       /MFx   - Keep file size at least x times what's required (x > 1.0)"
  65.          PRINT #10, "       /EUx   - Leave room for at least x more users"
  66.          END
  67.       END IF
  68.  
  69.       TempFile$ = "$$USERS$.$$$"
  70.  
  71. 100   MsgsFile$ = RTRIM$(LTRIM$(LEFT$(A$, I)))
  72.       OPEN MsgsFile$ FOR RANDOM AS #1 LEN = 128
  73.       FIELD 1, 128 AS M$
  74.  
  75. 110   UsersFile$ = RTRIM$(LTRIM$(MID$(A$, I)))
  76.       OPEN UsersFile$ FOR RANDOM AS #2 LEN = 128
  77.       FIELD 2, 128 AS U$
  78.       UserRecs = LOF(2) \ 128
  79.  
  80.       IF MID$(UsersFile$, 2, 1) = ":" THEN
  81.          TempFile$ = LEFT$(UsersFile$, 2) + TempFile$
  82.       END IF
  83.  
  84. 120   PRINT #10, CHR$(254) + " Reading "; UsersFile$; "...";
  85.       UsersRecsUsed = 0
  86.       TempRecs$ = ""
  87.       FOR I = 1 TO UserRecs
  88.          GET #2, I
  89.          IF ValidUser(U$) THEN
  90.             UserRecsUsed = UserRecsUsed + 1
  91.             TempRecs$ = TempRecs$ + MKI$(I)
  92.          END IF
  93.       NEXT
  94.       PRINT #10, UserRecsUsed; "of"; UserRecs; "Records Used."
  95.  
  96.       IF MultiplyFactor! = 1! THEN
  97.          UserRecsRequired = UserRecsUsed + ExtraUsers
  98.       ELSE
  99.          UserRecsRequired = MultiplyFactor! * UserRecsUsed
  100.          IF UserRecsRequired - UserRecsUsed < ExtraUsers THEN
  101.             UserRecsRequired = UserRecsUsed + ExtraUsers
  102.          END IF
  103.       END IF
  104.  
  105.       FOR I = 3 TO 15
  106.          IF I = 14 THEN
  107.             PRINT #10, CHR$(254) + " Can't Rehash..."
  108.             CLOSE 1, 2
  109.             END
  110.          END IF
  111.          IF 2 ^ I > UserRecsRequired THEN
  112.             UserRecsRequired = 2 ^ I
  113.             EXIT FOR
  114.          END IF
  115.       NEXT
  116.  
  117.       IF UserRecsRequired = UserRecs THEN
  118.          PRINT #10, CHR$(254) + " No Resizing Required..."
  119.          CLOSE 1, 2
  120.          END
  121.       END IF
  122.  
  123. 130   PRINT #10, CHR$(254) + " Resizing File to"; UserRecsRequired; "Records... ";
  124.  
  125.       Recs$ = TempRecs$
  126.       OPEN TempFile$ FOR RANDOM AS #3 LEN = 128
  127.       FIELD 3, 128 AS T$
  128.  
  129. 140   LSET T$ = SPACE$(128)
  130. 150   FOR I = 1 TO UserRecsRequired
  131.          PUT 3, I
  132.       NEXT
  133.  
  134.       WHILE Recs$ <> ""
  135.          I = CVI(LEFT$(Recs$, 2))
  136.          Recs$ = MID$(Recs$, 3)
  137. 160      GET #2, I
  138.          X = HashTo(U$, UserRecsRequired)
  139.          IF X = -1 THEN
  140.             PRINT #10, "Failed."
  141. 170         CLOSE 3
  142.             IF UserRecsRequired = 16384 THEN
  143.                PRINT #10, CHR$(254) + " Can't Rehash..."
  144.                CLOSE 1, 2
  145.                END
  146.             END IF
  147.             UserRecsRequired = UserRecsRequired * 2
  148.             GOTO 130
  149.          END IF
  150. '        PRINT #10, "  "; RTRIM$(LEFT$(U$, 31)); ":"; I; "->"; X
  151. 180      LSET T$ = U$
  152. 190      PUT 3, X
  153.       WEND
  154.  
  155.       CLOSE 2, 3
  156. 200   KILL UsersFile$
  157. 210   NAME TempFile$ AS UsersFile$
  158.  
  159. 220   GET 1, 1
  160.       MID$(M$, 57, 5) = STR$(UserRecsUsed)
  161. 230   PUT 1, 1
  162. 240   CLOSE 1
  163.  
  164.       PRINT #10, "Done."
  165.       END
  166.  
  167. 999   IF ERL = 100 THEN
  168.          PRINT #10, "Can't Find Messages File '"; MsgsFile$; "'..."
  169.          END
  170.       ELSEIF ERL = 110 THEN
  171.          PRINT #10, "Can't Find Users File '"; UsersFile$; "'..."
  172.          END
  173.       ELSE
  174.          PRINT #10, "Weird Error"; ERR; "at Line"; ERL; "Has Occurred..."
  175.          END
  176.       END IF
  177.  
  178. '*  HASHTO
  179. '*---------------------------------------------------------------------------
  180. '*
  181. '*  Returns the user record to put a given user, or -1 if no more room
  182. '*
  183. '*
  184.       FUNCTION HashTo (V$, MaxPos)
  185.  
  186.       UserName$ = RTRIM$(LEFT$(V$, 31))
  187.       L = LEN(UserName$)
  188.  
  189.       EmptyRec$ = SPACE$(31)
  190.  
  191.       SecondHash = (ASC(MID$(UserName$, 2, 1)) * 10 + 7) MOD MaxPos
  192.  
  193.       PrimeHash = ASC(MID$(UserName$, 1, 1)) * 100
  194.       PrimeHash = PrimeHash + ASC(MID$(UserName$, L / 2 + .1, 1)) * 10
  195.       PrimeHash = PrimeHash + ASC(RIGHT$(UserName$, 1))
  196.       PrimeHash = (PrimeHash MOD MaxPos) + 1
  197.  
  198.       FIELD 3, 128 AS T$
  199.  
  200.       I = PrimeHash
  201.       Found = FALSE
  202.       FOR Count = 1 TO 25
  203.          IF I <= 0 THEN
  204.             EXIT FOR
  205.          END IF
  206. 300      GET 3, I
  207.          IF LEFT$(T$, 31) = EmptyRec$ THEN
  208.             HashTo = I
  209.             Found = TRUE
  210.             EXIT FOR
  211.          END IF
  212.          I = I + SecondHash
  213.          IF I > MaxPos - 1 THEN
  214.             I = I - MaxPos
  215.          END IF
  216.       NEXT
  217.  
  218.       IF NOT Found THEN
  219.          HashTo = -1
  220.       END IF
  221.       END FUNCTION
  222.  
  223. '*  VALIDUSER
  224. '*---------------------------------------------------------------------------
  225. '*
  226. '*  Returns TRUE or FALSE depending on whether a given user should
  227. '*  be kept in the users file.
  228. '*
  229.       FUNCTION ValidUser (U$)
  230.       SHARED OlderThan, ExemptLevel
  231.       B$ = LEFT$(U$, 31)
  232.       ValidUser = TRUE
  233.       IF MID$(B$, 2, 12) = "deleted user" OR LEFT$(B$, 7) = "NEWUSER" THEN
  234.          ValidUser = FALSE
  235.       ELSEIF B$ = SPACE$(31) OR B$ = STRING$(31, 0) THEN
  236.          ValidUser = FALSE
  237.       ELSE
  238.          D$ = DATE$
  239.          DaysOld = (VAL(MID$(D$, 9, 2)) - VAL(MID$(U$, 112, 2))) * 365          ' YY
  240.          DaysOld = DaysOld + (VAL(MID$(D$, 1, 2)) - VAL(MID$(U$, 106, 2))) * 30 ' MM
  241.          DaysOld = DaysOld + VAL(MID$(D$, 4, 2)) - VAL(MID$(U$, 109, 2))        ' DD
  242.          IF DaysOld > OlderThan THEN
  243.             UserSecLevel = CVI(MID$(U$, 47, 2))
  244.             IF UserSecLevel < ExemptLevel THEN
  245.                ValidUser = FALSE
  246.             END IF
  247.          END IF
  248.       END IF
  249.       END FUNCTION
  250.  
  251.