rlgreen
asked on
Creating an encrypted password
I (newbie) am writing an application for a call center. I am using VB6 and information will be stored in an Access97 DB. I am wondering if anyone has any good encyrption/decryption code for allowing a user to log in to the system. The only way I know how to do it, is to hard code the passwords. But, I know that is not the way to do it. Thanks
ASKER
I'm sorry Waty, I can seem to get this to work. I appreciate your time you spent on it.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Waty, I got that one to work (class encryption), but I noticed that that periodically it will put a "S" where there should be an "o". Any ideas?
no :(
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 25/04/1999
' * Time : 11:05
' **************************
' * Comments : NSA's clipper algorithm
' *
' *
' **************************
Private f
Private k As Long
Private u As Long
Private Key(0 To 131) As String
Public Function Decrypt(Entry As String, PassKey As String) As String
Dim p$, s$, t$, u$
On Error Resume Next
s = Entry
p = PassKey
InitCrypt p
Do Until Len(s) = 0
u = ""
u = Left$(s, 16)
s = Right$(s, Len(s) - 16)
If Len(u) > 0 Then
t = t + CLDecrypt(u)
End If
Loop
Decrypt = Trim$(t)
End Function
Public Function Encrypt(Entry As String, PassKey As String) As String
Dim p$, s$, t$, u$
On Error Resume Next
s = Entry
p = PassKey
InitCrypt p
t = ""
Do Until Len(s) = 0
u = ""
If Len(s) > 6 Then
u = Left$(s, 6)
s = Right$(s, Len(s) - 6)
Else
u = Left$(s + " ", 6)
s = ""
End If
If Len(u) > 0 Then
t = t + CLEncrypt(u)
End If
Loop
Encrypt = t
End Function
Private Function BigTrans(ByVal inp As String) As Double
inp = Right$(inp, 8)
tempstr = String$(8 - Len(inp), "0") + inp
inp = ""
For loopit = 1 To 8
tempnum = Val("&H" + Mid$(tempstr, loopit, 1))
For loopinner = 3 To 0 Step -1
If tempnum And 2 ^ loopinner Then
inp = inp + "1"
Else
inp = inp + "0"
End If
Next loopinner
Next loopit
Dim o As Double, i As Integer
o = 0
For i = Len(inp) To 1 Step -1
If Mid(inp, i, 1) = "1" Then
Y = 1
p = (Len(inp) - i)
x = 2
Do While p > 0
Do While (p / 2) = (p 2)
x = (x * x) Mod 255
p = p / 2
Loop
Y = (x * Y) Mod 255
p = p - 1
Loop
o = o + Y
End If
Next i
BigTrans = o
End Function
Private Function BigXOR(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
tempnum = Len(value1) - Len(value2)
If tempnum < 0 Then
valueans = Left$(value2, Abs(tempnum))
value2 = Mid$(value2, Abs(tempnum) + 1)
ElseIf tempnum > 0 Then
valueans = Left$(value1, Abs(tempnum))
value1 = Mid$(value1, tempnum + 1)
End If
For loopit = 1 To Len(value1)
valueans = valueans + Hex$(Val("&H" + Mid$(value1, loopit, 1)) Xor Val("&H" + Mid$(value2, loopit, 1)))
Next loopit
BigXOR = Right(valueans, 8)
End Function
Private Function CLDecrypt(inp As String) As String
Dim w1(0 To 32) As String, w3(0 To 32) As String, w4(0 To 32) As String, w2(0 To 32) As String
Dim Counter(0 To 32) As Byte
Dim s As String
w1(32) = Mid(inp, 1, 4)
w2(32) = Mid(inp, 5, 4)
w3(32) = Mid(inp, 9, 4)
w4(32) = Mid(inp, 13, 4)
k = 32
u = 31
For i = 0 To 32
Counter(i) = i + 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = BigXOR(InvG(w2(k), Key()), BigXOR(w3(k), Hex(Counter(k - 1))))
w3(k - 1) = w4(k)
w4(k - 1) = w1(k)
u = u - 1
k = k - 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = w3(k)
w3(k - 1) = w4(k)
w4(k - 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter(k - 1)))
u = u - 1
k = k - 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = BigXOR(InvG(w2(k), Key()), BigXOR(w3(k), Hex(Counter(k - 1))))
w3(k - 1) = w4(k)
w4(k - 1) = w1(k)
u = u - 1
k = k - 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = w3(k)
w3(k - 1) = w4(k)
w4(k - 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter(k - 1)))
u = u - 1
k = k - 1
Next
s = Trim$(w1(0) & w2(0) & w3(0) & w4(0))
s = DeHex(s)
If InStr(s, Chr$(0)) > 0 Then
s = Left$(s, InStr(s, Chr$(0)) - 1)
End If
CLDecrypt = s
End Function
Private Function CLEncrypt(Entry As String) As String
Dim w1(0 To 32) As String, w3(0 To 32) As String, w4(0 To 32) As String, w2(0 To 32) As String
Dim Counter As Long
Dim s As String
s = Entry
s = EnHex(s)
w1(0) = Mid(s, 1, 4)
w2(0) = Mid(s, 5, 4)
w3(0) = Mid(s, 9, 4)
w4(0) = Mid(s, 13, 4)
k = 0
Counter = 1
For i = 1 To 8
w1(k + 1) = BigXOR(BigXOR(G(w1(k), Key()), w4(k)), Hex(Counter))
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = w2(k)
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
For i = 1 To 8
w1(k + 1) = w4(k)
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter))
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
For i = 1 To 8
w1(k + 1) = BigXOR(BigXOR(G(w1(k), Key()), w4(k)), Hex(Counter))
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = w2(k)
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
For i = 1 To 8
w1(k + 1) = w4(k)
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter))
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
CLEncrypt = w1(32) & w2(32) & w3(32) & w4(32)
End Function
Private Function DeHex(inp As String) As String
For i = 1 To Len(inp) Step 2
x = x & Chr(Val("&H" & Mid(inp, i, 2)))
Next i
DeHex = x
End Function
Private Function EnHex(x As String) As String
For i = 1 To Len(x)
v = Hex(Asc(Mid(x, i, 1)))
If Len(v) = 1 Then
v = "0" & v
End If
inp = inp & v
Next i
EnHex = inp
End Function
Private Function G(inp As String, Key() As String) As String
Dim g1 As String
Dim g2 As String
Dim g3 As String
Dim g4 As String
Dim g5 As String
Dim g6 As String
Dim l As String
g1 = Mid(inp, 1, 2)
g2 = Mid(inp, 3, 2)
l = f(CByte(BigTrans(BigXOR(g2
g3 = BigXOR(l, g1)
l = f(CByte(BigTrans(BigXOR(g3
g4 = BigXOR(l, g2)
l = f(CByte(BigTrans(BigXOR(g4
g5 = BigXOR(l, g3)
l = f(CByte(BigTrans(BigXOR(g5
g6 = BigXOR(l, g4)
l = g5 & g6
G = l
End Function
Private Sub InitCrypt(Pass As String)
Dim i As Long
Dim m As String
f = Array("A3", "D7", "09", "83", "F8", "48", "F6", "F4", "B3", "21", "15", "78", "99", "B1", "AF", "F9", "E7", "2D", "4D", _
"8A", "CE", "4C", "CA", "2E", "52", "95", "D9", "1E", "4E", "38", "44", "28", "0A", "DF", "02", "A0", "17", "F1", _
"60", "68", "12", "B7", "7A", "C3", "E9", "FA", "3D", "53", "96", "84", "6B", "BA", "F2", "63", "9A", "19", "7C", _
"AE", "E5", "F5", "F7", "16", "6A", "A2", "39", "B6", "7B", "0F", "C1", "93", "81", "1B", "EE", "B4", "1A", "EA", _
"D0", "91", "2F", "B8", "55", "B9", "DA", "85", "3F", "41", "BF", "E0", "5A", "58", "80", "5F", "66", "0B", "D8", _
"90", "35", "D5", "C0", "A7", "33", "06", "65", "69", "45", "00", "94", "56", "6D", "98", "9B", "76", "97", "FC", _
"B2", "C2", "B0", "FE", "DB", "20", "E1", "EB", "D6", "E4", "DD", "47", "4A", "1D", "42", "ED", "9E", "6E", "49", _
"3C", "CD", "43", "27", "D2", "07", "D4", "DE", "C7", "67", "18", "89", "CB", "30", "1F", "8D", "C6", "8F", "AA", _
"C8", "74", "DC", "C9", "5D", "5C", "31", "A4", "70", "88", "61", "2C", "9F", "0D", "2B", "87", "50", "82", "54", _
"64", "26", "7D", "03", "40", "34", "4B", "1C", "73", "D1", "C4", "FD", "3B", "CC", "FB", "7F", "AB", "E6", "3E", _
"5B", "A5", "AD", "04", "23", "9C", "14", "51", "22", "F0", "29", "79", "71", "7E", "FF", "8C", "0E", "E2", "0C", _
"EF", "BC", "72", "75", "6F", "37", "A1", "EC", "D3", "8E", "62", "8B", "86", "10", "E8", "08", "77", "11", "BE", _
"92", "4F", "24", "C5", "32", "36", "9D", "CF", "F3", "A6", "BB", "AC", "5E", "6C", "A9", "13", "57", "25", "B5", _
"E3", "BD", "A8", "3A", "01", "05", "59", "2A", "46")
SetKey Pass
End Sub
Private Function InvG(inp As String, Key() As String) As String
Dim g1 As String
Dim g2 As String
Dim g3 As String
Dim g4 As String
Dim g5 As String
Dim g6 As String
Dim l As String
g5 = Mid(inp, 1, 2)
g6 = Mid(inp, 3, 2)
l = f(CByte(BigTrans(BigXOR(g5
g4 = BigXOR(l, g6)
l = f(CByte(BigTrans(BigXOR(g4
g3 = BigXOR(l, g5)
l = f(CByte(BigTrans(BigXOR(g3
g2 = BigXOR(l, g4)
l = f(CByte(BigTrans(BigXOR(g2
g1 = BigXOR(l, g3)
l = g1 & g2
InvG = l
End Function
Private Sub SetKey(Pass As String)
For i = 0 To 131 Step 10
If i = 130 Then
Key(i + 0) = Mid(Pass, 1, 2)
Key(i + 1) = Mid(Pass, 3, 2)
Else
Key(i + 0) = Mid(Pass, 1, 2)
Key(i + 1) = Mid(Pass, 3, 2)
Key(i + 2) = Mid(Pass, 5, 2)
Key(i + 3) = Mid(Pass, 7, 2)
Key(i + 4) = Mid(Pass, 9, 2)
Key(i + 5) = Mid(Pass, 11, 2)
Key(i + 6) = Mid(Pass, 13, 2)
Key(i + 7) = Mid(Pass, 15, 2)
Key(i + 8) = Mid(Pass, 17, 2)
Key(i + 9) = Mid(Pass, 19, 2)
End If
Next
End Sub