[RESOLVED] Encrypting Password VB6

[VBFnewcomer]

I found the below code for encryption/Decryption by CV Michael

'You can Encrypt AND Decrypt using the same function
'(with the same password of course)
Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
    '
    '  Made by Michael Ciurescu
    ' (CVMichael from vbforums.com)
    '  Original thread: http://www.vbforums.com/showthread.php?t=231798
    '
    Dim SK As Long, K As Long
    
    ' init randomizer for password
    Rnd -1
    Randomize Len(Password)
    ' (((K Mod 256) Xor Asc(Mid$(Password, K, 1))) Xor Fix(256 * Rnd)) -> makes sure that a
    ' password like "pass12" does NOT give the same result as the password "sspa12" or "12pass"
    ' or "1pass2" etc. (or any combination of the same letters)
    
    For K = 1 To Len(Password)
        SK = SK + (((K Mod 256) _
        Xor Asc(Mid$(Password, K, 1))) _
        Xor Fix(256 * Rnd))
    Next K
    
    ' init randomizer for encryption/decryption
    Rnd -1
    Randomize SK
    
    ' encrypt/decrypt every character using the randomizer
    For K = 1 To Len(Str)
        Mid$(Str, K, 1) = Chr(Fix(256 * Rnd) _
        Xor Asc(Mid$(Str, K, 1)))
    Next K
    
    RndCrypt = Str
End Function

Can somebody show how to utilise the same in the below situation....
I have a password protected access db which i connect using ADO. Now the during the design the pass is wide open (one need to simply see the password parameter of connection string). Is there some way where the pass can be encrypted even in design time and stored within the code itself. The actual pass would be available to the connection string at runtime.

Or you may suggest an alternate method
Remember at no time the pass is visible (even to me)

[CVMichael]

Try this:
http://www.vbforums.com/showpost.php...8&postcount=11

[Milk]

Here's something reasonably strong and simple. It's only suitable for relatively short data (less characters than the prime)
Use different numbers if you can. P must be prime and M must be a prime root of P, (P-1) * M must not overflow.

Public Function SimpleEncrypt(text As String) As String
Dim B() As Byte, i As Long, N As Long, P As Long, M As Long
    N = 2
    P = N ^ 20 - 3 'a prime number (1048573)
    M = N ^ 11 - 5 'a prime root of the above prime (2043)
    N = N ^ 17 - 567 'arbitrary number
    B = text
    For i = 0 To UBound(B) Step 2
        N = (N * M) Mod P
        B(i) = B(i) Xor (N And 95)
    Next i
    SimpleEncrypt = B
End Function

Debug.Print SimpleEncrypt("There's a hole in my bucket, dear Liza, dear Liza, There's a hole in the bucket, dear Liza, a hole.")

Debug.Print SimpleEncrypt("Yr7588j;(k7`3)tmwe/k%ahn5b0$*{sql#Ol+pf{':73n5= onR*c/%5x!4:)&h-,(phn{)ur88t;}""mn)0+6Ot4""bf%rrrgp")

[VBFnewcomer]

I did bring the functions as pointed out by you into module.

Public Function RC4(ByVal Expression As String, ByVal Password As String) As String
    On Error Resume Next
    Dim RB(0 To 255) As Integer, X As Long, Y As Long, Z As Long, Key() As Byte, ByteArray() As Byte, Temp As Byte
    If Len(Password) = 0 Then
        Exit Function
    End If
    If Len(Expression) = 0 Then
        Exit Function
    End If
    If Len(Password) > 256 Then
        Key() = StrConv(Left$(Password, 256), vbFromUnicode)
    Else
        Key() = StrConv(Password, vbFromUnicode)
    End If
    For X = 0 To 255
        RB(X) = X
    Next X
    X = 0
    Y = 0
    Z = 0
    For X = 0 To 255
        Y = (Y + RB(X) + Key(X Mod Len(Password))) Mod 256
        Temp = RB(X)
        RB(X) = RB(Y)
        RB(Y) = Temp
    Next X
    X = 0
    Y = 0
    Z = 0
    ByteArray() = StrConv(Expression, vbFromUnicode)
    For X = 0 To Len(Expression)
        Y = (Y + 1) Mod 256
        Z = (Z + RB(Y)) Mod 256
        Temp = RB(Y)
        RB(Y) = RB(Z)
        RB(Z) = Temp
        ByteArray(X) = ByteArray(X) Xor (RB((RB(Y) + RB(Z)) Mod 256))
    Next X
    RC4 = StrConv(ByteArray, vbUnicode)
End Function
Public Function Base64Encoding(StrToEncode As String) As String
    Static EncodeTable(0 To 63) As Byte
    
    Dim K As Long, OutStr() As Byte, StrIn() As Byte, Lng As Long
    
    If EncodeTable(0) = 0 Then
        For K = 0 To 25
            EncodeTable(K) = Asc("A") + K
        Next K
        
        For K = 0 To 25
            EncodeTable(K + 26) = Asc("a") + K
        Next K
        
        For K = 0 To 9
            EncodeTable(K + 52) = Asc("0") + K
        Next K
        
        EncodeTable(62) = Asc("+")
        EncodeTable(63) = Asc("/")
    End If
    
    If StrToEncode = "" Then Exit Function
    
    StrIn = StrConv(StrToEncode, vbFromUnicode)
    If (Len(StrToEncode) Mod 3) = 0 Then
        ReDim OutStr((Len(StrToEncode) \ 3) * 4 - 1)
    Else
        ReDim OutStr(((Len(StrToEncode) \ 3) + 1) * 4 - 1)
    End If
    
    For K = 0 To Len(StrToEncode) \ 3 - 1
        Lng = StrIn(K * 3 + 2) Or (StrIn(K * 3 + 1) * &H100&) Or (StrIn(K * 3) * &H10000)
        
        OutStr(K * 4 + 0) = EncodeTable((Lng And &HFC0000) \ &H40000)
        OutStr(K * 4 + 1) = EncodeTable((Lng And &H3F000) \ &H1000&)
        OutStr(K * 4 + 2) = EncodeTable((Lng And &HFC0&) \ &H40&)
        OutStr(K * 4 + 3) = EncodeTable(Lng And &H3F&)
    Next K
    
    If (Len(StrToEncode) Mod 3) = 1 Then
        Lng = StrIn(UBound(StrIn)) * &H10000
        
        OutStr(UBound(OutStr) - 3) = EncodeTable((Lng And &HFC0000) \ &H40000)
        OutStr(UBound(OutStr) - 2) = EncodeTable((Lng And &H3F000) \ &H1000&)
        OutStr(UBound(OutStr) - 1) = Asc("=")
        OutStr(UBound(OutStr) - 0) = Asc("=")
    ElseIf (Len(StrToEncode) Mod 3) = 2 Then
        Lng = (StrIn(UBound(StrIn)) * &H100&) Or (StrIn(UBound(StrIn) - 1) * &H10000)
        
        OutStr(UBound(OutStr) - 3) = EncodeTable((Lng And &HFC0000) \ &H40000)
        OutStr(UBound(OutStr) - 2) = EncodeTable((Lng And &H3F000) \ &H1000&)
        OutStr(UBound(OutStr) - 1) = EncodeTable((Lng And &HFC0&) \ &H40&)
        OutStr(UBound(OutStr) - 0) = Asc("=")
    End If
    
    Base64Encoding = StrConv(OutStr, vbUnicode)
End Function

Public Function Base64Decoding(StrToDecode As String, Optional CheckInvalidChars As Boolean = True) As String
    Static DecodeTable(0 To 255) As Byte
    
    Dim OutStr() As Byte, StrIn() As Byte
    Dim K As Long, Lng As Long
    
    If DecodeTable(0) = 0 Then
        For K = 0 To 255
            DecodeTable(K) = 255
        Next K
        
        For K = 0 To 25
            DecodeTable(K + 65) = K
        Next K
        
        For K = 26 To 51
            DecodeTable(K + 71) = K
        Next K
        
        For K = 52 To 61
            DecodeTable(K - 4) = K
        Next K
        
        DecodeTable(43) = 62
        DecodeTable(47) = 63
    End If
    
    If StrToDecode = "" Then Exit Function
    
    StrToDecode = Trim(StrToDecode)
    
    If CheckInvalidChars Then
        For K = 0 To 255
            If Not (Chr(K) Like "[A-Za-z0-9+/=]") Then
                StrToDecode = Replace(StrToDecode, Chr(K), "")
            End If
        Next K
    End If
    
    StrIn() = StrConv(StrToDecode, vbFromUnicode)
    ReDim OutStr(0 To ((Len(StrToDecode) \ 4) * 3 - 1))
    
    For K = 0 To Len(StrToDecode) \ 4 - 2
        Lng = DecodeTable(StrIn(K * 4 + 3))
        Lng = Lng Or (DecodeTable(StrIn(K * 4 + 2)) * &H40&)
        Lng = Lng Or (DecodeTable(StrIn(K * 4 + 1)) * &H1000&)
        Lng = Lng Or (DecodeTable(StrIn(K * 4 + 0)) * &H40000)
        
        OutStr(K * 3 + 0) = (Lng And &HFF0000) \ &H10000
        OutStr(K * 3 + 1) = (Lng And &HFF00&) \ &H100&
        OutStr(K * 3 + 2) = Lng And &HFF&
    Next K
    
    Lng = 0
    If DecodeTable(StrIn(K * 4 + 3)) <> 255 Then Lng = DecodeTable(StrIn(K * 4 + 3))
    If DecodeTable(StrIn(K * 4 + 2)) <> 255 Then Lng = Lng Or (DecodeTable(StrIn(K * 4 + 2)) * &H40&)
    If DecodeTable(StrIn(K * 4 + 1)) <> 255 Then Lng = Lng Or (DecodeTable(StrIn(K * 4 + 1)) * &H1000&)
    If DecodeTable(StrIn(K * 4 + 0)) <> 255 Then Lng = Lng Or (DecodeTable(StrIn(K * 4 + 0)) * &H40000)
    
    OutStr(K * 3 + 0) = (Lng And &HFF0000) \ &H10000
    OutStr(K * 3 + 1) = (Lng And &HFF00&) \ &H100&
    OutStr(K * 3 + 2) = Lng And &HFF&
    
    If StrIn(UBound(StrIn) - 1) = 61 Then
        Base64Decoding = Left(StrConv(OutStr, vbUnicode), UBound(OutStr) - 1)
    ElseIf StrIn(UBound(StrIn)) = 61 Then
        Base64Decoding = Left(StrConv(OutStr, vbUnicode), UBound(OutStr) - 0)
    Else
        Base64Decoding = StrConv(OutStr, vbUnicode)
    End If
End Function

But Iam not comfortable with immediate windows. Could you please show some other way of implementation/testing

[CVMichael]

I know this might seem rude, but get confortable....

Because the Immediate window is an important part of VB6, it is the debug window... and every VB6 programmer should know how to use it.

You can do so many things with it... debug your application, display variable data (for debugging again), execute statements from your code (that are public in a module), execute math expressions... all this is very usefull when building your application...

So... copy & paste that line of code into the immediate window:
Rnd -99999: ? Base64Encoding(RC4("value you want to encrypt", CStr(Rnd)))
change the random number, and your value, something like
Rnd -1237788: ? Base64Encoding(RC4("my_password_1234", CStr(Rnd)))
And when you press enter (to execute), it will display the result in the next line in the immediate window.

Then use the result into the line where you want to read the password (or whatever value you want to store), but with the same random value you chose before
Rnd -1237788: My_Setting_Variable = RC4(Base64Decoding("copy & paste the result you had in the immediate window here"), CStr(Rnd))

The -1237788 number, can be any number, but it has to be negative.

[VBFnewcomer]

Because the Immediate window is an important part of VB6, it is the debug window... and every VB6 programmer should know how to use it.

I'll try to learn...
for starter what does : in

Rnd -99999: ? Base64Encoding(RC4("value you want to encrypt", CStr(Rnd)))

do

[si_the_geek]

That allows you to write two (or more) lines of code on one line, you could also do this:

Msgbox "a" : Msgbox "b"

I'm guessing your next question will be about the ? , which is a shorthand version of Debug.Print (ie: print to the Immediate window)

[VBFnewcomer]

I'm guessing your next question will be about the ? , which is a shorthand version of Debug.Print (ie: print to the Immediate window)

gee no (anyway thanks for refreshing me) but Rnd -99999 I presume we are feeding random, can't we write Base64Encoding(RC4("value you want to encrypt", CStr(Rnd -99999))) why have 2 statements

[RhinoBull]

I'm guessing your next question will be about the ? , which is a shorthand version of Debug.Print (ie: print to the Immediate window)

The question mark (?) is a shortcut for a PRINT statement that prints on the form - vb will automatically convert it to keyword Print.
I'd rather avoid using it.

VBFnewcomer:
you may find this function very helpfull.

[si_the_geek]

The question mark (?) is a shortcut for a PRINT statement that prints on the form - vb will automatically convert it to keyword Print.

Without an object specified, the Print method prints to the current object.. which in this case is the immediate window (and as such, the ? does not get converted to the word Print).

[RhinoBull]

Are you talking about using that char in code window or debug windows?
I most often get lost in your words. Sorry.

[si_the_geek]

The debug window (which has a window title of "Immediate"), as that is what was being discussed in the previous posts (including an explicit reference in the post before mine).

[RhinoBull]

If it's in debug window then you're right.

[CVMichael]

gee no (anyway thanks for refreshing me) but Rnd -99999 I presume we are feeding random, can't we write Base64Encoding(RC4("value you want to encrypt", CStr(Rnd -99999))) why have 2 statements

No it's not the same thing !

Rnd -some_number
Initialized the random seed, you are passing -99999 as a parameter to the Rnd

But CStr(Rnd - 99999), calls Rnd, gets the result, then from the result it will substract -99999

To see what I mean, run this code a few times:

Private Sub Form_Load()
    Randomize
    Rnd -99999
    Debug.Print Rnd
End Sub

And you should always get 0.7118068 value

But if you run this code

Private Sub Form_Load()
    Randomize
    Debug.Print Rnd - 99999
End Sub

You will get something like:
-99998.1794012189
-99998.4593084455

So as you can see CStr(Rnd - 99999), just substracts 99999 from the result of Rnd, instead of initializing the random seed

[VBFnewcomer]

Rnd -1237788: My_Setting_Variable = RC4(Base64Decoding("copy & paste the result you had in the immediate window here"), CStr(Rnd))

1.So I first encrypt the password using Base64Encoding (in the lab while noting down the rnd used)
2. add the Base64Decoding & RC4 functions to the proj (module)
3. add the result obtained using the Base64Encoding into a constant say Const PASS_CONST = "the resultant string"
4. generate a random using the same seed used for encoding
5. pass the PASS_CONST like this RC4(Base64Decoding(PASS_CONST), CStr(Rnd))
6. Have a variable to receive the value coming from the Base64Decoding()
7. And place the the same in the connection string at appropriate place
say (I am using access 2003 db for sample)

conn.connectionString = "Provider = 'Microsoft.Jet.OLEDB.4.0';" _
    & "Data Source = " & App.Path & "myDb.mdb;" _
    & "Jet OLEDB:Database Password = " & variableFrom Base64Decoding & ";"

or still better

Randomize
  Rnd -99999 'or whatever number must be negative as used while encoding
  conn.connectionString = "Provider = 'Microsoft.Jet.OLEDB.4.0';" _
    & "Data Source = " & App.Path & "myDb.mdb;" _
    & "Jet OLEDB:Database Password = " & RC4(Base64Decoding(PASS_CONST), CStr(Rnd)) & ";"

[CVMichael]

Looks like you got it right....

[VBFnewcomer]

Looks like you got it right....

Phew!
Gee thanks!
I'll keep the thread open for sometime to ensure to get some addl inputs from members

[TheNavigator]

Can you please explain how does #3 works?

[Milk]

Hi there, it uses a primitive root modulo n to produce an Xor key. It's a form of pseudo random number generation similar to Rnd. In short it will run through every number from 1 to the prime - 1 exactly once but not in order. Like Rnd it is not random it follows a complicated pattern.

I used the lines like P = N ^ 20 - 3 'a prime number (1048573) to obfuscate the values but that was a naive decision on my part as they will be resolved at compile time so the numbers can still be found within the executable... P = 1048573 will compile to the same.

I used N And 95 to restrict the bits to keep the resulting character printable. N And 255 can generate non printable characters.

It only works on ANSI strings or at least it ignores the the high byte of unicode strings.

I adapted it from something I was using to encrypt byte sequences where I was not concerned with these sequences being printable.

[TheNavigator]

I don't understand these parts

What does N ^ 20 - 3 mean?

and what does

B = text
    For i = 0 To UBound(B) Step 2
        N = (N * M) Mod P
        B(i) = B(i) Xor (N And 95)
    Next i
    SimpleEncrypt = B

mean?

And what does it mean to dim B as byte?

And what does

B = text

mean?

[dilettante]

I'm still puzzled why the password needs to be hidden while in design mode. Who are you hiding it from?

[CVMichael]

Which post are you referring to?

[Edit]
In the first post he is saying

Now the during the design the pass is wide open (one need to simply see the password parameter of connection string)

Since the password is stored in the connection string, even when compiled you will be able to see the password as plain text if you open the exe in notepad.

[chrishoney]

Here's something reasonably strong and simple. It's only suitable for relatively short data (less characters than the prime)
Use different numbers if you can. P must be prime and M must be a prime root of P, (P-1) * M must not overflow.

Public Function SimpleEncrypt(text As String) As String
Dim B() As Byte, i As Long, N As Long, P As Long, M As Long
    N = 2
    P = N ^ 20 - 3 'a prime number (1048573)
    M = N ^ 11 - 5 'a prime root of the above prime (2043)
    N = N ^ 17 - 567 'arbitrary number
    B = text
    For i = 0 To UBound(B) Step 2
        N = (N * M) Mod P
        B(i) = B(i) Xor (N And 95)
    Next i
    SimpleEncrypt = B
End Function

Debug.Print SimpleEncrypt("There's a hole in my bucket, dear Liza, dear Liza, There's a hole in the bucket, dear Liza, a hole.")

Debug.Print SimpleEncrypt("Yr7588j;(k7`3)tmwe/k%ahn5b0$*{sql#Ol+pf{':73n5= onR*c/%5x!4:)&h-,(phn{)ur88t;}""mn)0+6Ot4""bf%rrrgp")

thanks for this it has managed to encrypt password to database. but the problem now is users cannot log in with those passwords encrypted, whats the workaround

[Nightwalker83]

thanks for this it has managed to encrypt password to database. but the problem now is users cannot log in with those passwords encrypted, whats the workaround

Have a look in the VB6 codebank! I think there is a database password hashing example in there.

[chrishoney]

thanks doing so now

[chrishoney]

Have a look in the VB6 codebank! I think there is a database password hashing example in there.

hi i've gone through the codebank with no luck, some examples are only provide one way to encrypt to the database

[CVMichael]

It's in the first page: VB6 - Example on how to make a Login where password is stored hashed in Database

[chrishoney]

thanks for the heads up, had missed it, yes so if the user wants to type the normal password how will it work?

[si_the_geek]

They type it... then you encrypt it, and compare that to the encrypted version that you stored.

[chrishoney]

thanx, will try it and get back if successful or prob

[chrishoney]

thanks its working great...do you have the decryption function?

[Nightwalker83]

thanks its working great...do you have the decryption function?

Are you referring to CVMichael's code linked to in post #27?

[chrishoney]

Oh sorry i wasnt specific, am referring to one by Milk on Feb 9
Public Function SimpleEncrypt(text As String) As String
Dim B() As Byte, i As Long, N As Long, P As Long, M As Long
N = 2
P = N ^ 20 - 3 'a prime number (1048573)
M = N ^ 11 - 5 'a prime root of the above prime (2043)
N = N ^ 17 - 567 'arbitrary number
B = text
For i = 0 To UBound(B) Step 2
N = (N * M) Mod P
B(i) = B(i) Xor (N And 95)
Next i
SimpleEncrypt = B
End Function

[si_the_geek]

The implication from the bottom of his post is that it encrypts and decrypts.

[firoz.raj]

Does anyone know ? . what it is the use of the XOR Operator here. because i have never been used XOR Operator . Neither of the project .

B(i) = B(i) Xor (N And 95)

[chrishoney]

this link should help
http://msdn.microsoft.com/en-us/library/csw1x2a6.aspx

[firoz.raj]

but i need to know why any need of xor operator .it says very first condition is true other is also true .then first condition xor second condition = false .but why any need of it in the case .