DECLARE FUNCTION HashTo% (V$, MaxPos%)
DECLARE FUNCTION ValidUser% (U$)

'*  REHASH.BAS
'*---------------------------------------------------------------------------
'*
'*  Quick 'N Dirty utility to auto-size/pack a RBBS users file
'*
'*  10-04-90
'*

      ON ERROR GOTO 999
      DEFINT A-Z

      CONST FALSE = 0
      CONST TRUE = -1

      OPEN "CONS:" FOR OUTPUT AS #10

      PRINT #10, "REHASH v1.10 10-04-90, Super-Dooper RBBS Users File Resizer, by Tom Collins"
      PRINT #10,

      A$ = COMMAND$
      A$ = UCASE$(LTRIM$(RTRIM$(A$)))

      ExemptLevel = 32000
      I = INSTR(A$, "/EL")
      IF I <> 0 THEN
         ExemptLevel = VAL(MID$(A$, I + 3))
      END IF
      OlderThan = 32000
      I = INSTR(A$, "/OT")
      IF I <> 0 THEN
         OlderThan = VAL(MID$(A$, I + 3))
      END IF
      ExtraUsers = 0
      MultiplyFactor! = 1!
      I = INSTR(A$, "/MF")
      IF I <> 0 THEN
         MultiplyFactor! = VAL(MID$(A$, I + 3))
         IF MultiplyFactor! < 1! OR MultiplyFactor! > 10! THEN
            MultiplyFactor! = 1!
         END IF
      END IF
      IF MultiplyFactor! = 1! THEN
         ExtraUsers = 8
      END IF
      I = INSTR(A$, "/EU")
      IF I <> 0 THEN
         X = VAL(MID$(A$, I + 3))
         IF X > 0 THEN
            ExtraUsers = X
         END IF
      END IF
      I = INSTR(A$, "/")
      IF I <> 0 THEN
         A$ = LEFT$(A$, I - 1)
      END IF
      I = INSTR(A$, " ")
      IF A$ = "" OR I = 0 THEN
         PRINT #10, "Usage: REHASH <Messages File> <Users File> [/ELx] [/OTx] [/MFx] [/EUx]"
         PRINT #10, "       /ELx   - Users >= Level x are exempt from packing"
         PRINT #10, "       /OTx   - Remove users who haven't been on in x days"
         PRINT #10, "       /MFx   - Keep file size at least x times what's required (x > 1.0)"
         PRINT #10, "       /EUx   - Leave room for at least x more users"
         END
      END IF

      TempFile$ = "$$USERS$.$$$"

100   MsgsFile$ = RTRIM$(LTRIM$(LEFT$(A$, I)))
      OPEN MsgsFile$ FOR RANDOM AS #1 LEN = 128
      FIELD 1, 128 AS M$

110   UsersFile$ = RTRIM$(LTRIM$(MID$(A$, I)))
      OPEN UsersFile$ FOR RANDOM AS #2 LEN = 128
      FIELD 2, 128 AS U$
      UserRecs = LOF(2) \ 128

      IF MID$(UsersFile$, 2, 1) = ":" THEN
         TempFile$ = LEFT$(UsersFile$, 2) + TempFile$
      END IF

120   PRINT #10, CHR$(254) + " Reading "; UsersFile$; "...";
      UsersRecsUsed = 0
      TempRecs$ = ""
      FOR I = 1 TO UserRecs
         GET #2, I
         IF ValidUser(U$) THEN
            UserRecsUsed = UserRecsUsed + 1
            TempRecs$ = TempRecs$ + MKI$(I)
         END IF
      NEXT
      PRINT #10, UserRecsUsed; "of"; UserRecs; "Records Used."

      IF MultiplyFactor! = 1! THEN
         UserRecsRequired = UserRecsUsed + ExtraUsers
      ELSE
         UserRecsRequired = MultiplyFactor! * UserRecsUsed
         IF UserRecsRequired - UserRecsUsed < ExtraUsers THEN
            UserRecsRequired = UserRecsUsed + ExtraUsers
         END IF
      END IF

      FOR I = 3 TO 15
         IF I = 14 THEN
            PRINT #10, CHR$(254) + " Can't Rehash..."
            CLOSE 1, 2
            END
         END IF
         IF 2 ^ I > UserRecsRequired THEN
            UserRecsRequired = 2 ^ I
            EXIT FOR
         END IF
      NEXT

      IF UserRecsRequired = UserRecs THEN
         PRINT #10, CHR$(254) + " No Resizing Required..."
         CLOSE 1, 2
         END
      END IF

130   PRINT #10, CHR$(254) + " Resizing File to"; UserRecsRequired; "Records... ";

      Recs$ = TempRecs$
      OPEN TempFile$ FOR RANDOM AS #3 LEN = 128
      FIELD 3, 128 AS T$

140   LSET T$ = SPACE$(128)
150   FOR I = 1 TO UserRecsRequired
         PUT 3, I
      NEXT

      WHILE Recs$ <> ""
         I = CVI(LEFT$(Recs$, 2))
         Recs$ = MID$(Recs$, 3)
160      GET #2, I
         X = HashTo(U$, UserRecsRequired)
         IF X = -1 THEN
            PRINT #10, "Failed."
170         CLOSE 3
            IF UserRecsRequired = 16384 THEN
               PRINT #10, CHR$(254) + " Can't Rehash..."
               CLOSE 1, 2
               END
            END IF
            UserRecsRequired = UserRecsRequired * 2
            GOTO 130
         END IF
'        PRINT #10, "  "; RTRIM$(LEFT$(U$, 31)); ":"; I; "->"; X
180      LSET T$ = U$
190      PUT 3, X
      WEND

      CLOSE 2, 3
200   KILL UsersFile$
210   NAME TempFile$ AS UsersFile$

220   GET 1, 1
      MID$(M$, 57, 5) = STR$(UserRecsUsed)
230   PUT 1, 1
240   CLOSE 1

      PRINT #10, "Done."
      END

999   IF ERL = 100 THEN
         PRINT #10, "Can't Find Messages File '"; MsgsFile$; "'..."
         END
      ELSEIF ERL = 110 THEN
         PRINT #10, "Can't Find Users File '"; UsersFile$; "'..."
         END
      ELSE
         PRINT #10, "Weird Error"; ERR; "at Line"; ERL; "Has Occurred..."
         END
      END IF

'*  HASHTO
'*---------------------------------------------------------------------------
'*
'*  Returns the user record to put a given user, or -1 if no more room
'*
'*
      FUNCTION HashTo (V$, MaxPos)

      UserName$ = RTRIM$(LEFT$(V$, 31))
      L = LEN(UserName$)

      EmptyRec$ = SPACE$(31)

      SecondHash = (ASC(MID$(UserName$, 2, 1)) * 10 + 7) MOD MaxPos

      PrimeHash = ASC(MID$(UserName$, 1, 1)) * 100
      PrimeHash = PrimeHash + ASC(MID$(UserName$, L / 2 + .1, 1)) * 10
      PrimeHash = PrimeHash + ASC(RIGHT$(UserName$, 1))
      PrimeHash = (PrimeHash MOD MaxPos) + 1

      FIELD 3, 128 AS T$

      I = PrimeHash
      Found = FALSE
      FOR Count = 1 TO 25
         IF I <= 0 THEN
            EXIT FOR
         END IF
300      GET 3, I
         IF LEFT$(T$, 31) = EmptyRec$ THEN
            HashTo = I
            Found = TRUE
            EXIT FOR
         END IF
         I = I + SecondHash
         IF I > MaxPos - 1 THEN
            I = I - MaxPos
         END IF
      NEXT

      IF NOT Found THEN
         HashTo = -1
      END IF
      END FUNCTION

'*  VALIDUSER
'*---------------------------------------------------------------------------
'*
'*  Returns TRUE or FALSE depending on whether a given user should
'*  be kept in the users file.
'*
      FUNCTION ValidUser (U$)
      SHARED OlderThan, ExemptLevel
      B$ = LEFT$(U$, 31)
      ValidUser = TRUE
      IF MID$(B$, 2, 12) = "deleted user" OR LEFT$(B$, 7) = "NEWUSER" THEN
         ValidUser = FALSE
      ELSEIF B$ = SPACE$(31) OR B$ = STRING$(31, 0) THEN
         ValidUser = FALSE
      ELSE
         D$ = DATE$
         DaysOld = (VAL(MID$(D$, 9, 2)) - VAL(MID$(U$, 112, 2))) * 365          ' YY
         DaysOld = DaysOld + (VAL(MID$(D$, 1, 2)) - VAL(MID$(U$, 106, 2))) * 30 ' MM
         DaysOld = DaysOld + VAL(MID$(D$, 4, 2)) - VAL(MID$(U$, 109, 2))        ' DD
         IF DaysOld > OlderThan THEN
            UserSecLevel = CVI(MID$(U$, 47, 2))
            IF UserSecLevel < ExemptLevel THEN
               ValidUser = FALSE
            END IF
         END IF
      END IF
      END FUNCTION