Article ID: 179371
Article Last Modified on 1/22/2007
Public Function KeyCode(Password As String) As Long
' This function will produce a unique key for the
' string that is passed in as the Password.
Dim I As Integer
Dim Hold As Long
For I = 1 To Len(Password)
Select Case (Asc(Left(Password, 1)) * I) Mod 4
Case Is = 0
Hold = Hold + (Asc(Mid(Password, I, 1)) * I)
Case Is = 1
Hold = Hold - (Asc(Mid(Password, I, 1)) * I)
Case Is = 2
Hold = Hold + (Asc(Mid(Password, I, 1)) * _
(I - Asc(Mid(Password, I, 1))))
Case Is = 3
Hold = Hold - (Asc(Mid(Password, I, 1)) * _
(I + Len(Password)))
End Select
Next I
KeyCode = Hold
End Function
Table: tblPassword
---------------------------
Field Name: ObjectName
Data Type: Text
Field Size: 50
Field Name: KeyCode
Data Type: Number
Field Size: Long Integer
Input Mask: Password
Table Properties: tblPassword
-----------------------------
PrimaryKey: ObjectName
ObjectName: Orders
KeyCode: 2818
Private Sub Form_Open(Cancel as Integer)
Dim Hold As Variant
Dim tmpKey As Long
Dim I As Integer
Dim rs As Recordset
Dim db As Database
On Error GoTo Error_Handler
' Check to see if the user is passing in the Password.
Hold = InputBox("Please Enter Your Password", "Enter Password")
' Open the table that contains the password.
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPassword", dbOpenTable)
rs.Index = "PrimaryKey"
rs.Seek "=", Me.Name
If rs.NoMatch Then
MsgBox "Sorry cannot find password info. Please Try Again"
Cancel = -1
Else
' Test to see if the key generated matches the key in
' the table; if there is not a match, stop the form
' from opening.
If Not (rs![keycode] = KeyCode(Cstr(Hold))) Then
MsgBox "Sorry you entered the wrong password. " & _
"Please try again.", vbOKOnly, "Incorrect Password"
Cancel = -1
End If
End If
rs.Close
db.Close
Exit Sub
Error_Handler:
MsgBox Err.Description, vbOKOnly, "Error #" & Err.Number
Exit Sub
End Sub
Additional query words: password-protected pass word
Keywords: kbhowto kbprogramming KB179371