Public Class CPassword

  '=============  Symbolic Constants ======================
  Private Const MINLENGTH = 4     ' Password must have 4 to 30 characters
  Private Const MAXLENGTH = 30

  Private Const MINSECURITY = 1   ' Ten levels of security clearance
  Private Const MAXSECURITY = 10
  '========================================================

  '=================  Private Data ========================
  Private Structure Security        ' Hold relevant information in a structure
    Dim User As String              ' A list of the users for this program
    Dim Pass As String              ' The password
    Dim SecurityLevel As Integer    ' Each user has a security level
  End Structure

  Private Shared UserCount As Integer      ' How many users

  Private Shared UserList() As Security

  Private Check As Integer
  Private EncodedPW As String
  Private DecodedPW As String
  '========================================================
  Shared Sub New()
    ' If this was being used in a real program, this
    ' code would probably read the user data from a
    ' database file. We just fake it here.

    ReDim UserList(100)
    With UserList(0)
      .User = "Debbie Plesluska"
      .Pass = "Diamonds"
      .SecurityLevel = 8
    End With
    With UserList(1)
      .User = "Jay Crannell"
      .Pass = "Whiff"
      .SecurityLevel = 8
    End With
    With UserList(2)
      .User = "Jim McAllister"
      .Pass = "Slice"
      .SecurityLevel = 6
    End With
    With UserList(3)
      .User = "Jack"
      .Pass = "Joyce1"
      .SecurityLevel = 10
    End With
    UserCount = 4

  End Sub

  Public Function AddNewUser(ByVal User As String, ByVal Password As String, ByVal SecurityLevel As Integer) As Integer
    ' Purpose   This function is used to add a new user to the system. The
    '           code checks the length of the password and then check to 
    '           see if the name entered is already in the list. If either
    '           check fails, logic False is returned.
    '
    ' Argument list:
    '   User            The name of the user
    '   Password            A string that contains the password
    '   SecurityLevel   The clearance for this user
    '
    ' Return Value:
    '   integer         True if set OK; False otherwise
    '
    Dim i, length As Integer
    Dim buff As String

    ' See if password length OK
    If Password.Length < MINLENGTH Or Password.Length > MAXLENGTH Then
      Return False
    End If

    ' Check security level
    If SecurityLevel < MINSECURITY Or SecurityLevel > MAXSECURITY Then
      Return False
    End If

    ' See if the name is already in use.
    For i = 0 To UserCount - 1
      If UCase(UserList(i).User) = UCase(User) Then
        Return False
      End If
    Next

    UserCount += 1            ' Add one to the list

    If UserCount >= UserList.GetUpperBound(0) Then   ' See if we need to grow
      ReDim Preserve UserList(UserCount + 10)       ' the user list.
    End If

    ' If we get here, it's ok to add them:
    With UserList(UserCount)
      .User = User
      .Pass = Password
      .SecurityLevel = SecurityLevel
    End With

    Return True               ' Everything's fine

  End Function

  Public Function SetPassword(ByVal User As String, ByVal Password As String) As String
    ' Purpose   This function is used to encode the password string entered
    '           by the user. It does this by adding four numeric characters
    '           to the front of the sting followed by the password charac-
    '           ters themselves. Each character is calculated as the char-
    '           acter modulo 26 plus the length of the password.
    '
    ' Argument list:
    '   Password          A string that contains the password
    '   User              The name of the user
    '
    ' Return Value:
    '   string           The encoded password
    '
    Check = CreateChecksum(User)
    EncodedPW = EncodePassword(Password, Check)
    SetPassword = EncodedPW

  End Function

  Public Function GetSecurityLevel(ByVal User As String) As Integer
    ' Purpose   This routine is used to retrieve the security level of the
    '           user.
    '
    ' Argument list:
    '   User          The user for this password
    '
    ' Return Value:
    '   integer       The security level of the user. It returns 0
    '                 if the user is not found
    '
    Dim i As Integer

    For i = 0 To UserCount - 1
      If UCase(UserList(i).User) = UCase(User) Then
        Return UserList(i).SecurityLevel
      End If
    Next i
    Return 0

  End Function

  Public Function CheckPassword(ByVal User As String, ByVal Password As String) As Integer
    ' Purpose   This routine is used to check for a password match for a
    '           user.
    '
    ' Argument list:
    '   User          The user for this password
    '   Password      A string that contains the password
    '
    ' Return Value:
    '   integer       True if set if the correct password is given,
    '                 False otherwise
    '
    Dim i As Integer

    For i = 0 To UserCount - 1
      If UCase(UserList(i).User) = UCase(User) Then
        If UCase(UserList(i).Pass) = UCase(Password) Then
          Return True     ' Match
        End If
      End If
    Next i
    Return False          ' No match

  End Function

  Public Function GetPassword(ByVal User As String, ByVal Password As String) As String
    ' Purpose   This routine is used to check for a password match for a
    '           user. 

    ' **********    Right now it is just a way to check the encoding and 
    ' **********    decoding.
    '
    ' Argument list:
    '   User          The user for this password
    '   Password      A string that contains the password
    '
    ' Return Value:
    '   string        the decoded password
    '                 False otherwise
    '
    Dim Temp As String, OriginalPW As String

    OriginalPW = Password
    Check = CreateChecksum(User)
    EncodedPW = EncodePassword(Password, Check)

    Temp = DecodePassword(EncodedPW, Check)

    If UCase(Temp) = UCase(OriginalPW) Then
      Return Temp     ' Match
    Else
      Return ""    ' No match
    End If

  End Function

  '================= Helper Functions  ======================

  Private Function CreateChecksum(ByVal User As String) As Integer
    ' Purpose   This routine is used to create a checksum for a password.
    '           This is done by taking the numeric value of each character
    '           in the user's name and adding it up. The stored value is 
    '           is the sum modulus 26.
    '
    ' Argument list:
    '   User          The user name for this password
    '
    ' Return Value:
    '   integer       The checksum
    '
    Dim i As Integer, sum As Long

    sum = 0
    For i = 0 To Len(User) - 1
      sum += Asc(User.Substring(i, 1))
    Next i
    CreateChecksum = sum Mod 26

  End Function

  Private Function DecodePassword(ByVal p As String, ByVal Check As Integer) As String
    ' Purpose   This routine is used to decode a password.
    '
    ' Argument list:
    '   p           the password
    '   Check       the checksum for the password
    '
    ' Return Value:
    '   string      the decoded password
    '
    Dim i As Integer
    Dim length As Integer
    Dim s As String, w As String

    For i = 0 To 3
      s &= Chr(Asc(p.Substring(i, 1)) - 26)
    Next i
    length = Val(s.Substring(0, 2))   ' The password length is first 2 chars
    Check = Val(s.Substring(2, 2))    ' Next two chars are checksum

    For i = 4 To length + 3
      w = w + Chr(Asc(p.Substring(i, 1)) - Check)
    Next i
    DecodePassword = w

  End Function

  Private Function EncodePassword(ByVal Pass As String, ByVal Check As Integer) As String
    ' Purpose:  This routine is used to encode the password string entered
    '           by the user. It does this by adding two numeric characters
    '           to the front of the string followed by the password charac-
    '           ters themselves. Each character is calculated as the char-
    '           acter modulo 26 plus the length of the password.
    '
    ' Parameters:
    '   Pass      the password to encode
    '   Check     the checksum for the password
    '
    ' Return value:
    '   string    the encoded password
    '
    Dim s, cs, d, buff As String
    Dim Temp, i, length As Integer

    d = Format$(Len(Pass), "00")
    s = Format$(Check, "00")
    buff = d & s

    cs = ""
    For i = 0 To 3            ' Format length and checksum into password
      Temp = Asc(buff.Substring(i, 1)) + 26
      cs &= Format$(Chr(Temp))
    Next i

    d = ""
    For i = 0 To Len(Pass) - 1  ' Encode the password itself using checksum
      Temp = Asc(Pass.Substring(i, 1)) + Check
      d = d & Chr(Temp)
    Next i

    s = d
    Randomize()
    For i = Len(d) To MAXLENGTH - 4        ' Fill in the rest with random chars
      Temp = 0
      Do While Temp < 32 Or Temp > 127
        Temp = Rnd() * 127
      Loop
      s = s & Chr(Temp)
    Next i

    Pass = cs & s             ' Put the pieces together
    EncodePassword = Pass

  End Function

End Class
