Encrypting Password

[cassey14]

Hi!I am doing a login form but i have this problem I want to encrypt the password they entered and save it in database..Can someone help me?Thank You in Advance..


-cassey

[ADezii]

Hi!I am doing a login form but i have this problem I want to encrypt the password they entered and save it in database..Can someone help me?Thank You in Advance..


-cassey

I'll look up a simple encryption algorithm as soon as I get a chance and post it for you.

[NeoPa]

This is a very basic one that I use.

'If I told you what this did I'd have to kill you.
Public Function Scramble(strPW As String)
    Dim intIdx As Integer
 
    Scramble = strPW
    For intIdx = 1 To Len(strPW)
        Mid(Scramble, intIdx, 1) = _
            Chr(&H40 Or (Not Asc(Mid(strPW, intIdx, 1))) And &H3F)
    Next intIdx
End Function

I expect the ADezii comes up with will be less predictable.

[ADezii]

Hi!I am doing a login form but i have this problem I want to encrypt the password they entered and save it in database..Can someone help me?Thank You in Advance..


-cassey

As promised, any questions feel free to ask:

Public Function fEncryptString(TheString As String, ByVal nbrPlaces As Byte) As String
'*******************************
' Author: Philfr               *
' Email : [e-mail]  *
' Date  : 25 - 5 - 02          *
'******************************************************************************************
'This is a simple Encryption Algorithm. Knowing all 'printable' characters are 8
'Bytes long, you can shift the bits to the left and still have a printable character.
'To Decrypt, all you have to do is to shift them left until you have come full circle
'as in the following calling procedures:
'to Encrypt: fEncryptString(TheString, nbrPlaces)
'to Decrypt: fEncryptString(TheString, 8 - nbrPlaces)
 
Dim tmp As Integer, i As Integer, mult As Integer
Dim intLength As Integer, tmpSt As String
 
intLength = Len(TheString)
tmpSt = ""
nbrPlaces = nbrPlaces Mod 8     'no point doing more than 7, besides
mult = 2 ^ nbrPlaces                  'mult (an Integer) would be too small
 
For i = 1 To intLength
  tmp = Asc(Mid$(TheString, i, 1))          'get the ASCII value of each character
  tmp = tmp * mult                             'apply the multiplier
  tmp = tmp Mod 256 + tmp \ 256             'rotate any 'carry' bit
  tmpSt = tmpSt & Chr$(tmp)                 'add the character to the String
Next i
 
fEncryptString = tmpSt
End Function

[cassey14]

Thank You so much for all the reply..I will test this 2 codes today and ill let you know what happen..thanx!

[NeoPa]

You're welcome.
We're interested in success stories as well as problems. It helps other readers of the thread to know that the answer works.

[cassey14]

You're welcome.
We're interested in success stories as well as problems. It helps other readers of the thread to know that the answer works.

Hi!I tried your code..Can you please explain to me how it works?

[NeoPa]

'If I told you what this did I'd have to kill you.
Public Function Scramble(strPW As String)
    Dim intIdx As Integer
 
    Scramble = strPW
    For intIdx = 1 To Len(strPW)
        Mid(Scramble, intIdx, 1) = _
            Chr(&H40 Or (Not Asc(Mid(strPW, intIdx, 1))) And &H3F)
    Next intIdx
End Function

Clearly you're not worried about the warning on line one then ;(
It's essentially a Bitwise OR operation.
There is, however, provision made for ensuring that all characters produced are printable characters so, no matter where it us used / stored, you should have no problems.

[cassey14]

'If I told you what this did I'd have to kill you.
Public Function Scramble(strPW As String)
    Dim intIdx As Integer
 
    Scramble = strPW
    For intIdx = 1 To Len(strPW)
        Mid(Scramble, intIdx, 1) = _
            Chr(&H40 Or (Not Asc(Mid(strPW, intIdx, 1))) And &H3F)
    Next intIdx
End Function

Clearly you're not worried about the warning on line one then ;(
It's essentially a Bitwise OR operation.
There is, however, provision made for ensuring that all characters produced are printable characters so, no matter where it us used / stored, you should have no problems.

Ok. Thanx so much I already got it..Thank you so much!

[sjreynolds143]

Hi.

I know that this is a very old thread, but I found it because I wanted to do exactly this - but found that neither solution quite worked for me.

NeoPa's solution works well, but not for punctuation. When you run it on the encrypted string, alpha and numbers return to normal but e.g. space turns to '

ADezii's solution is better, in that sense, but for the right settings will cheerfully return a character less than 32 - for example "P" shifted by 5 gives a LF. Fine if all you are doing is storing it in a field that doesn't care, but in my case I wanted to write it to an external file and that would mess up the record.

So what I came up with in the end was this. Thought I'd share in case anyone else found it useful.

Function sEncryptString(ByVal sPlainText As String) As String
 
    Dim iIndex As Integer
    Dim iEncoder As Integer
    Dim iEncodedVal As Integer
 
    ' Each character will be XORed with a (different) random value 0-255.
    ' The beauty of XOR is that you undo it simply by XORing with the same value
    '
    ' The output string will be twice as long as the input string,
    ' because we need to store the value that we used to XOR
    '
    ' Because it will be stored in a "plain text" file (e.g. a definition file)
    ' We MUST have printable characters so no XOR value or resultant character code
    ' is permitted to be <32 or 127 (DEL). That is why we are encoding each character
    ' with a different code, because it is easier to check for these values rather than
    ' repeating the entire encode endlessly until we find one that is good.
 
    Randomize                                           ' Initialise the random number generator
    sEncryptString = ""
    For iIndex = 1 To Len(sPlainText)
        Do
            iEncoder = Int(94 * Rnd + 32)               ' Use an encoder value between 32 and 126
            iEncodedVal = Asc(Mid(sPlainText, iIndex, 1)) Xor iEncoder
        Loop While iEncodedVal = 127 Or iEncodedVal < 32
        sEncryptString = sEncryptString & Chr(iEncodedVal) & Chr(iEncoder)
    Next iIndex
 
End Function
 
Function sDecryptString(ByVal sEncryptedString As String) As String
 
    Dim iIndex As Integer
    Dim iDecodedVal As Integer
 
    ' This is the reverse of the encrypt function
    ' Simply take the first of each pair of characters and XOR it with the second
 
    sDecryptString = ""
    For iIndex = 1 To Len(sEncryptedString) Step 2
        iDecodedVal = Asc(Mid(sEncryptedString, iIndex, 1)) Xor Asc(Mid(sEncryptedString, iIndex + 1, 1))
        sDecryptString = sDecryptString & Chr(iDecodedVal)
    Next iIndex
 
End Function
 

[NeoPa]

There's no reason not to add to an old discussion if it's still relevant and you feel you have something to add. It may be interesting to see an explanation of what the code's doing though.

[sjreynolds143]

By all means.

The Encrypt routine goes through the string, one letter at a time, and performs a bitwise Exclusive-Or (XOR) on the ASCII value of the character using a random number that has been generated in the range 32-126. It then adds both the new character and the character representing the random number to the encrypted string.

If you are not familiar with XOR, it is like OR except that two 1s produce a 0 output. It's advantage is that it is completely reversible, so that if C = A XOR B, then A = C XOR B.

My requirement was to write the encrypted string to a plain text file, so I had to have printable characters which didn't include DEL, BKSP or any of the control characters (ASCII values less than 32). So that is why the random number is created in the range it is, and why the XOR function has a loop to ensure that I keep repeating the encoding with different random numbers until I get a printable character.

I could have increased the range of the random number to 255 using a similar loop around the random number generator and setting it to give numbers up to 255, but thought that that was overkill for this application.

The decrypt routine reads the characters from the string in pairs. The first is the encrypted character, and the second is the value that was used to encrypt it. The first is the XORed with the second to recover the original character, which is then added to the output string

[NeoPa]

Thank you. That was well worth the read :-)

My latest version handles the same problem differently. It uses all 256 possible values, but instead of storing the character itself, which can cause problems in some environments due to many possible values not being printable, it stores (the ASCII codes of) the hex digits of the character. The encryption algorithm used is RC4 (RC4 Encryption Algorithm for VBA and VBScript) and different projects can use different hashes to ensure the data doesn't become too predictable or recognisable.

[sjreynolds143]

Interesting, thanks. When I have a little more time, I'll try and get my mind around the RC4 code in the linked article. For the application I am developing, what I have now is probably sufficient, but always good to learn new things.

[NeoPa]

That is much as my attitude was when I first came across it. Eventually I found the time to incorporte it into my standard code, and I haven't looked back :-)