VB - 31 Bit Encryption function

You can Encrypt AND Decrypt using the same function (with the same password of course)

VB Code:

Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
    '
    '  Made by Michael Ciurescu (CVMichael from vbforums.com)
    '  Original thread: [url]http://www.vbforums.com/showthread.php?t=231798[/url]
    '
    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

Hi Micheal,


Was a useful code. One which really worked the way I wanted it. Thanks to you. One works out of 100zz.... thanks once again..

--putta:-)

Forgive me for I am new at this encryption/hashing. Can you tell me in this code what each line is doing. For example:

Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
What is the 'Str' being passed in? I can see the 'Password is the value to encrypt/unencrypt but am not sure what the 'Str' is. Again I basically have no experience with encryption/hashing.


Thanks

Your code:
Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
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

And of course I neglected to format the code!! My apologies...

I tryed your encryption code. and tryed as a test to encrypt you example as a test in a text box. after decryption this is all I got back. what's wrong? any ideas

[Highlight=VB]
Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
Dim SK As Long, K As Long

' init ran
[Highlight=VB]

mojo69, if you want to encrypt, you generally have a string that you want to encrypt and the password to encrypt it with...

So, having said that, wich one do you think is which ?

Quote:

---

Originally Posted by dreamvb

after decryption this is all I got back.

---

What did you get back ?

Quote:

---

What did you get back ?

---

Well basically your example does not decrypt correctly. for example. Asumeing I paste this into a text Box

line 1
line 2
line 3
line 4
line 5
line 6
line 7
line 8

Now I use your code in a command button example:

Private Sub Command1_Click()
Text1.Text = RndCrypt(Text1.Text, "pass")
End Sub

That will encrypt the the text right. so now I go to decrypt the encryped text and this is what I get back.

line 1
line 2
line 3
line 4
lin

what you should be getting back is the original data that was put in.
anyway it works ok for small passwords.

There's nothing wrong with my encryption function.

Did you try just storing the encrypted text in a string ? (without putting the output in the TextBox ?)

Why do you need to display something (the encrypted text) that you won't be able to understand anyways ?

You should test and see why it hapens before you blame someone else.

VB Code:

Private Sub Command1_Click()
    Dim S As String
    S = RndCrypt(Text1.Text, "pass")
    
    Text2.Text = S
    Debug.Print Len(S), Len(Text2.Text), Asc(Mid(S, 36, 1)), Asc(Mid(S, 37, 1))
End Sub

You will see that Len(Text2.Text) = 35 even thought the Len(S) = 62, so how is that possible ?, it means that when you assign S to the text box, not all data goes in it...

Why only 35 characters go in the text box ? because the 36'th character is 0...
A text box stops displaying the text if it encounters 0... so there you go... that's the problem.

And as I was saying before, you should not display the encrypted text for 2 reasons. One you don't need to look at it ? (or do you ?) and two, the text box control does not display all data if the data contains the 0 ASCII character...

Quote:

---

Originally Posted by dreamvb

anyway it works ok for small passwords.

---

Actually, the bigger the password, the more secure is the encryption... and it works with a password of any size...

Ok Thanks. I take it I was in the wrong. anyway nise Code keep up the good work.
5 * from me

I've got a problem (and it could be me, I suppose). If I use the following combination of string and password it returns an inconclusive final character:

pumpkins
shadowhawk

All other combinations seem to work OK, but with these two the returned string has a NULL on the end as far as I can tell.
Any clues, or is it me?
Thanks,
Chips.

Ahhh..
CVMichael, you seem to have already answered this one, although I still need to understand why this happens.
Rather than display the result as text, I debug.print the HEX value of each character and the final value in this case is '0', not '00' as I'd expect.
Chips.

OK, I really should have sat down and worked this out before I posted.
Sorry to waste your time. It works perfectly. Rating your original post right now.

Thanks,
Chips.

hi
one more such function is

Public Function Crypt(strOriginal, encrypting) As String
Dim valString$, x%
For x = 1 To Len(strOriginal)
If encrypting = True Then
valString = Asc(Mid(strOriginal, x, 1)) + (x ^ 2)
Do While valString > 255
valString = valString - 255
Loop
Else
valString = Asc(Mid(strOriginal, x, 1)) - (x ^ 2)
Do While valString <= 0
valString = valString + 255
Loop
End If
Crypt = Crypt & Chr(valString)
Next

End Function

Quote:

---

Originally Posted by sakshi

hi
one more such function is

VB Code:

Public Function Crypt(strOriginal, encrypting) As String
    Dim valString$, x%
    For x = 1 To Len(strOriginal)
        If encrypting = True Then
            valString = Asc(Mid(strOriginal, x, 1)) + (x ^ 2)
            Do While valString > 255
            valString = valString - 255
            Loop
         Else
            valString = Asc(Mid(strOriginal, x, 1)) - (x ^ 2)
            Do While valString <= 0
                valString = valString + 255
            Loop
        End If
        Crypt = Crypt & Chr(valString)
    Next
End Function

---

Hi sakshi, remember when you paste code, to encapsulate it in [vbcode]your vb code here[/vbcode]

This code:

VB Code:

Do While valString > 255
   valString = valString - 255
Loop

can be written as:

VB Code:

valString = ValString Mod 256

Instead of the do while loop...

Also, the function you pasted, is an encoding function, NOT an encryption function. An encryption function requires a password also. This function always encodes the same. An encryption function has different result every time the password changes.

Is there any way to modify your code to only print alphanumeric characters?
Also It would be nice if you could set the length of the encrypted output.

Say I wanted to encrypted "mynameistegan" using the key "mykey" but I wanted to make sure that the encrypted output is always 25 characters.

Quote:

---

Originally Posted by Tegan

Is there any way to modify your code to only print alphanumeric characters?

---

That will defy the purpose of the encryption. The encryption can encrypt binary data, so therefore the output will be binary.
For what you are asking you should use Base64 encoding after you encrypt your data.
Here is a link to my Base64 Encoding and Decoding.
http://www.vbforums.com/showpost.php...53&postcount=4

Quote:

---

Originally Posted by Tegan

Also It would be nice if you could set the length of the encrypted output.

Say I wanted to encrypted "mynameistegan" using the key "mykey" but I wanted to make sure that the encrypted output is always 25 characters.

---

The RndCrypt function does not change the length of the string, so before you encrypt, you can set YOUR data the predefined length that you need.
Something like:

VB Code:

Private Sub Form_Load()
    Dim Str As String, EncStr As String
    
    ' some string to encrypt
    Str = "akjhgkjdfhgklsjdfhgf"
    
    ' make the string 50 characters long
    Str = Str & String(50 - Len(Str), 0)
    
    ' encrypt the string
    EncStr = RndCrypt(Str, "my password")
    
    ' the encrypted length is 50 (same as the original)
    Debug.Print Len(Str), Len(EncStr)
End Sub

Changed a few things around and got the function executing faster.

VB Code:

Option Explicit
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Function RandomBinaryB(ByVal tmpLength As Long) As String
    Dim tmpRandomBinaryB() As Byte
    Dim tmpIndex As Long
    ReDim tmpRandomBinaryB(tmpLength - 1)
    For tmpIndex = 0 To tmpLength - 1
        tmpRandomBinaryB(tmpIndex) = Int(Rnd * 256)
    Next
    RandomBinaryB = StrConv(tmpRandomBinaryB, vbUnicode)
End Function
 
Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
    ' Made by Michael Ciurescu (CVMichael from vbforums.com)
    ' Original thread: [url]http://www.vbforums.com/showthread.php?t=231798[/url]
    Dim SK As Long, K As Long
    Rnd -1
    Randomize Len(Password)
    For K = 1 To Len(Password)
        SK = SK + (((K Mod 256) Xor Asc(Mid$(Password, K, 1))) Xor Fix(256 * Rnd))
    Next K
    Rnd -1
    Randomize SK
    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
 
Public Function RndCryptB(ByRef tmpToEncrypt As String, ByVal tmpPassword As String) As String
    ' Original function/idea by Michael Ciurescu (CVMichael from vbforums.com)
    ' This function by frozen on vbforums.com
    ' Original thread: [url]http://www.vbforums.com/showthread.php?t=231798[/url]
    Dim tmpToEncryptB() As Byte
    Dim tmpPasswordB() As Byte
    Dim tmpIndex As Long
    Dim tmpSeed As Long
    Rnd -1
    Randomize Len(tmpPassword)
    tmpPasswordB = StrConv(tmpPassword, vbFromUnicode)
    For tmpIndex = 0 To UBound(tmpPasswordB) - 1
        tmpSeed = tmpSeed + (((tmpIndex Mod 256) Xor tmpPasswordB(tmpIndex)) Xor Fix(256 * Rnd))
    Next
    Rnd -1
    Randomize tmpSeed
    tmpToEncryptB = StrConv(tmpToEncrypt, vbFromUnicode)
    For tmpIndex = 0 To UBound(tmpToEncryptB) - 1
        tmpToEncryptB(tmpIndex) = Fix(256 * Rnd) Xor tmpToEncryptB(tmpIndex)
    Next tmpIndex
    RndCryptB = StrConv(tmpToEncryptB, vbUnicode)
End Function
 
Private Sub Form_Load()
    Dim tmpBinary As String
    Dim tmpIndex As Long
    Dim tmpTicks As Long
    tmpBinary = RandomBinaryB(1048576)
    For tmpIndex = 0 To 5
        tmpTicks = GetTickCount()
        Call RndCrypt(tmpBinary, "abc")
        Debug.Print tmpIndex, "RndCrypt(tmpBinary, abc)", GetTickCount() - tmpTicks
        tmpTicks = GetTickCount()
        Call RndCryptB(tmpBinary, "abc")
        Debug.Print tmpIndex, "RndCryptB(tmpBinary, abc)", GetTickCount() - tmpTicks
    Next
End Sub

Code:

---

0            RndCrypt(tmpBinary, abc)    828
 0            RndCryptB(tmpBinary, abc)    313
 1            RndCrypt(tmpBinary, abc)    812
 1            RndCryptB(tmpBinary, abc)    313
 2            RndCrypt(tmpBinary, abc)    828
 2            RndCryptB(tmpBinary, abc)    328
 3            RndCrypt(tmpBinary, abc)    844
 3            RndCryptB(tmpBinary, abc)    328
 4            RndCrypt(tmpBinary, abc)    812
 4            RndCryptB(tmpBinary, abc)    313
 5            RndCrypt(tmpBinary, abc)    828
 5            RndCryptB(tmpBinary, abc)    312

---

Quote:

---

Originally Posted by frozen

Changed a few things around and got the function executing faster.

---

It's nice, but... I could have done the same thing if anyone would have asked me to....

Why bother, you came up with the idea and kept it simple for people looking to learn. I was just using it on rather large strings and had to speed it up so I posted it.

Just so you know, your the man. I love your code.

Can anyone tell me about how strong 31 bit encryption is? I've read that 128 is "uncrackable" with today's technology but roughly how strong is 31 bit?

Quote:

---

Originally Posted by Chris H

Can anyone tell me about how strong 31 bit encryption is? I've read that 128 is "uncrackable" with today's technology but roughly how strong is 31 bit?

---

Well, let me put it this way:
31 bit takes 2^31 = 2147483648 tries to break the encryption
128 bit takes 2^128 = 3.4028236692093846346337460743177e+38 tries to break it....

With my own computer (P4 3.5GHz), it would probably take a few hours to brake a 31 bit encryption

Duh.. nevermind

I'm not real experienced in encryption, but what makes this 31-bit? I'm not really sure. I've been told the length of the key is what determines what "bit" encryption it is, but I don't see how that would be true.

Also, what modifications would it take to make this into 128-bit encryption, 256? No need, it already seems pretty secure, I'm just curious.

What makes it 31 bit ?

Well, basically, how many tries (when broute forcing) it takes to break the encryption. And that number is how big the "key" is.

I this case, the "key" is the SK variable which is a Long type (32 bits), but in the for loop, I make the key starting at 0, so there is no negative numbers, therefore I'm not using one bit of the 32.

The encryption is actually less than 31 bit, because of the way the key is made, there are many combinations that can result into the same key.

So, for the 31 bit encryption, it takes 2^31=2147483648 tries to break it.

A 128 bit encryption has a key of 16 bytes (128 / 8), for this encryption it takes 2^128=3.4028236692093846346337460743177e+38 tries to break it, and that is a pretty big number...

Quote:

---

Originally Posted by CVMichael

What makes it 31 bit ?

Well, basically, how many tries (when broute forcing) it takes to break the encryption. And that number is how big the "key" is.

I this case, the "key" is the SK variable which is a Long type (32 bits), but in the for loop, I make the key starting at 0, so there is no negative numbers, therefore I'm not using one bit of the 32.

The encryption is actually less than 31 bit, because of the way the key is made, there are many combinations that can result into the same key.

So, for the 31 bit encryption, it takes 2^31=2147483648 tries to break it.

A 128 bit encryption has a key of 16 bytes (128 / 8), for this encryption it takes 2^128=3.4028236692093846346337460743177e+38 tries to break it, and that is a pretty big number...

---

Oh ok, that makes sense. :)

What if the text is only 4 bytes long though and the key is 128? It would still only take 16 tries right?

Sorry for the dumb questions.

Since the text is only 4 bytes, then it means that the encryption strength is 32 bits (4 bytes = 32 bits), even if the key is 128 bits (16 bytes). You need a text at least 16 bytes to take advantage of the full key...

Quote:

---

Originally Posted by DigiRev

What if the text is only 4 bytes long though and the key is 128? It would still only take 16 tries right?

---

I think you are confuzing what are bits, and what are bytes...

1 Byte = 8 bits = (2^8)=256 combinations
So 4 bytes = 4*8=32 bits... (2^32)=4,294,967,296 combinations

So if it's 4 bytes, then it takes 4,294,967,296 tries to break it... (that's how many combinations a long can take)

Quote:

---

Originally Posted by CVMichael

Since the text is only 4 bytes, then it means that the encryption strength is 32 bits (4 bytes = 32 bits), even if the key is 128 bits (16 bytes). You need a text at least 16 bytes to take advantage of the full key...

I think you are confuzing what are bits, and what are bytes...

1 Byte = 8 bits = (2^8)=256 combinations
So 4 bytes = 4*8=32 bits... (2^32)=4,294,967,296 combinations

So if it's 4 bytes, then it takes 4,294,967,296 tries to break it... (that's how many combinations a long can take)

---

Ah, that makes sense. :) I was thinking in terms of bytes and not bits.

This is a decent encryption function for personal use, but it does have weaknesses.

First weakness: the same function encrypts and decrypts the text. This seriously limits the mathematical properties of the function. I personally don't know how to exploit this, but it was one of the properties that helped them break enigma.

Second weakness: using VB6's random number generator with a calculated seed is clever, but in general a bad idea. From what I understand, the numbers that come out of typical RNGs are very predictable (from a cryptographic sense). I would bet this step doesn't contribute at all to the encryption, unless the attacker doesn't know the algorithm.

Third weakness: you're essentially hashing the password to get SK, which means multiple passwords will give the same result and SK can only have, as you say in the title, ~31 bits. Modern cryptographic algorithms use more along the lines of 128 to 1024 bits (or more, if you're really paranoid). Worse than that, I think some values of SK are more likely than others (not sure though).

How I would attack this encryption:
- Figure out which values of SK are the most likely (possible taking into account the fact that normal people tend to use short passwords)
- Test each value, one after the other, until 'text' comes out (something that matches the frequency analysis for English)

Very good alkatran,

If you said those things, it means that you understand how the encryption works, and have a good idea how to crack it.

The thing is... I knew about the weaknesses for this encryption when I posted it. And I did not post it saying that this is a good encryption... I know it's a weak encryption. But thinking how many lines of code this one is for what it does... I think it's pretty good. I mean, beginners usually write encryptions by substracting a constant # from the ASCII code in the text, and call it encryption (but not to my standards), with a lot more code than this encryption.

This encryption is for when you want to hide things as opposed to plain text, that's why I wrote in the title "31 Bit...", thinking that everyone with some basic encryption knoledge, knows that 128 bit and higher is the standard today.

If you want to see a good encryption, take a look at this one:
VB - 128, 160 and 256 Bit File Encryption/Decryption with MD5, SHA1 and SHA256 (which is made by me also)
And yes... I know the pros & cons about that encryption also...

This is the simple encryption suitable for beginner like me.

Hence, I choose this encryption because my project do not required expert encryption.I also read through your another advance encryption. That was good and really professional.

I implemented your 32-bits encryption to my program. It was running smooth.
However, some of my network computer can't run this encryption. I study all the possible problem i found that my network vb compiler cannot compile the character §. Perhaply and possiblility that computer installed chinese input visual basic to allow user enter chinese work for coding.

Is that the problem on my side ?

Can you help me to explore it ?

Thanks :)

Sorry, I don't know how to work with Unicode data. Maybe you should ask your question in the Classic Visual Basic, that way, people who know about unicode will reply to your question... hopefully...

Ok CVMichael .
Thanks ..... ..... ..... .....

WOW!
I was looking for a way to encrypt some data... Ur code is amazing!! Works better than i expect. Thank you bud ;)

Hi CVMichael,

In order to understand security, one has to really understand how to break in or brute force. A person who has a good security system for their home is a person who knows how to break in their own home.

Therefore, I have three questions for you. One, how did you get so good with the encryption/decryption process?

Quote:

---

Originally Posted by CVMichael

Well, let me put it this way:
31 bit takes 2^31 = 2147483648 tries to break the encryption
128 bit takes 2^128 = 3.4028236692093846346337460743177e+38 tries to break it....

With my own computer (P4 3.5GHz), it would probably take a few hours to brake a 31 bit encryption

---

Two, how would you do this? I am very curious to understand this to understand counter preventative measures.

Three, what is a good pattern to keep passwords?

Thanks

Liquid Metal:cool:

BTW...

Code:

---

        Mid$(pi_strData, lngLP, 1) = Chr(Fix(256 * Rnd) Xor Asc(Mid$(pi_strData, lngLP, 1)))

---

I am a bit lost with this line. How does it know whether to pick the CHR side or the ASC side?

I had solved my problem.

Quote:

---

Originally Posted by Liquid Metal

One, how did you get so good with the encryption/decryption process?

---

Well... I was always fascinated by it, and in the past I spent weeks at a time to try to make encryption algorithms, I made so many I lost count. I once wanted to see how many I can make, and made around 20 (I did not keep the code) most of them using XOR but in different ways. I stopped at around 20 because I did not see any point in making so many, but theoretically, I could make hundreds of encryption algorithms, and hundrets of variations for each encryption... of course not many strong ones...
That's how I came up with this one, it was one of those 20, and also the other encryption algorithm I posted in the CodeBank: High Encryption

Quote:

---

Originally Posted by Liquid Metal

Two, how would you do this? I am very curious to understand this to understand counter preventative measures.

---

You also quoted when I said: "With my own computer (P4 3.5GHz), it would probably take a few hours to brake a 31 bit encryption"
Well, I was wrong !

It takes only 2 SECONDS !

I did not dare to actually try to break it until today *shame on me*, anyways, here's how to do "broute force":

Code:

---

Private Sub Form_Load()
    Dim SK As Long, K As Long
    Dim Str As String
    Dim EncStr As String
    Dim MsgStr As String
   
    ' Encrypt something
    EncStr = RndCrypt("Hello world !", "something 1")
   
    For SK = 1 To 2147483647
        Str = EncStr ' Reset to encrypted string
       
        ' Main encryption algorithm
        Rnd -1
        Randomize SK
       
        For K = 1 To Len(Str)
            Mid$(Str, K, 1) = Chr(Fix(256 * Rnd) Xor Asc(Mid$(Str, K, 1)))
        Next K
       
        ' Check to see if we have a valid string
        'If Str Like "*world*" Then
        If CheckPrintable(Str) Then
           
            MsgStr = "Encryption broken !" & vbNewLine & "Seed = " & SK & vbNewLine & "Full data = """ & Str & """"
            Debug.Print MsgStr
            MsgBox MsgStr
           
            Exit For
        End If
    Next SK
End Sub

Private Function CheckPrintable(ByVal Str As String) As Boolean
    Dim K As Long
    Dim PrintableChars As String
   
    ' for k = 32 to 126: ? chr(k); : next k
    PrintableChars = vbTab & " !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
   
    For K = 1 To Len(PrintableChars)
        Str = Replace(Str, Mid$(PrintableChars, K, 1), "")
    Next K
   
    CheckPrintable = Len(Str) = 0
End Function

---

But of course, you need the source code of the encryption algorithm to be able to do this...

Quote:

---

Originally Posted by Liquid Metal

Three, what is a good pattern to keep passwords?

---

Well, I'm not sure what you mean. To keep passwords ? as in to save log-in passwords in a database or file ? The best way is to HASH the password, because HASH-ing is not reversable (one way only)... that's why when you HASH, the ONLY way to break it is to broute force it...
If you mean what passwords you should use in general, you should not use words like english words (or whatever language), and mix letters with numbers and also characters like +-=/\[]@#$%^&*... etc... (you get the idea)

Quote:

---

Originally Posted by Liquid Metal

I am a bit lost with this line. How does it know whether to pick the CHR side or the ASC side?

---

Well, if you look carefully, the Chr holds everything in brackets, so first this runs:
Fix(256 * Rnd) Xor Asc(Mid$(pi_strData, lngLP, 1))
and then the result of all that is in Chr( ... )

[Edit]
See the new encryption based on this one, here: VB6 - 31 Bit Encryption - To the Next level

I am not sure if the Brute code worked because it returned some other data. It also took really long.

Also, I was refering to login passwords.

I have a question for you on the XOR but will start another thread since it is not really related to your post.

Thank you CVMichael.

Quote:

---

Originally Posted by Liquid Metal

I am not sure if the Brute code worked because it returned some other data. It also took really long.

---

Really ?
Did you modify the code in any way ?

Maybe your computer is slower than mine... I have a P4 3.5GHz 2GBytes RAM

here's the full code again, but I added timing also:

Code:

---

Option Explicit

Private Sub Form_Load()
    Dim SK As Long, K As Long
    Dim Str As String
    Dim EncStr As String
    Dim MsgStr As String
    Dim StartTime As Single
   
    ' Encrypt something
    EncStr = RndCrypt("Hello world !", "something 1")
   
    StartTime = Timer
    For SK = 1 To 2147483647
        Str = EncStr ' Reset to encrypted string
       
        ' Main encryption algorithm
        Rnd -1
        Randomize SK
       
        For K = 1 To Len(Str)
            Mid$(Str, K, 1) = Chr(Fix(256 * Rnd) Xor Asc(Mid$(Str, K, 1)))
        Next K
       
        ' Check to see if we have a valid string
        'If Str Like "*world*" Then
        If CheckPrintable(Str) Then
           
            MsgStr = "Encryption broken !" & vbNewLine & "Seed = " & SK & vbNewLine & "Full data = """ & Str & """" & vbNewLine & "Time taken: " & Timer - StartTime
            Debug.Print MsgStr
            MsgBox MsgStr
           
            Exit For
        End If
    Next SK
End Sub

Private Function CheckPrintable(ByVal Str As String) As Boolean
    Dim K As Long
    Dim PrintableChars As String
   
    ' for k = 32 to 126: ? chr(k); : next k
    PrintableChars = vbTab & " !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"
   
    For K = 1 To Len(PrintableChars)
        Str = Replace(Str, Mid$(PrintableChars, K, 1), "")
    Next K
   
    CheckPrintable = Len(Str) = 0
End Function

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

---

This is the result I get:

Code:

---

Encryption broken !
Seed = 1746
Full data = "Hello world !"
Time taken: 0.359125

---

So on my computer it takes only 1746 tries until it breaks the encryption, and that is done in only 360 ms

It works this time. Must be on my part earlier. Thanks for introducing to me the concept of brute force. I know what the phase mean but just never understand how one might crack the algorithm until now. I am going to try to understand it line by line.

I understand how XOR works now too, thanks to you, Si_The_Geek, LaVolpe and the rest from this post:
http://www.vbforums.com/showthread.php?t=498656.

Thanks again CVMichael!:thumb: :afrog: :cool:

does anyone know if this function can be ported to c++?

does anyone know if this function can be ported to c++?

Most likely...

Let me open C++ and try it...

Quote:

---

Originally Posted by CVMichael

Most likely...

Let me open C++ and try it...

---

thank you soooo much CVMichael.. you are a king among kings :bigyello: :) :bigyello:

Here it is...

I coded it in Turbo C++ Version 3.0, but it should work in any compiler... (hopefully)

Code:

---

#include <conio.h>
#include <stdio.h>
#include <time.h>
#include <stdlib.h>
#include <string.h>

char* RndCrypt(char* str, int str_len, char* password);

void main(void)
{
        int k;
        char *orig_str = "Hello world";
        int str_len = strlen(orig_str);
        char *enc_str = NULL;
        char *dec_str = NULL;

        while(kbhit()) getch();
        clrscr();

        printf("Original  = %s\n", orig_str);

        enc_str = RndCrypt(orig_str, str_len, "test_password4");

        printf("Encrypted = %s\n", enc_str);

        dec_str = RndCrypt(enc_str, str_len, "test_password4");

        printf("Decrypted = %s\n", dec_str);

        delete enc_str;
        delete dec_str;

        while(kbhit()) getch();
        getch();
        while(kbhit()) getch();
}

char* RndCrypt(char* str, int str_len, char* password)
{
        int k;
        int pass_len = strlen(password);
        unsigned long sk = 0;
        char * ret_val = new char[str_len + 1];

        srand(pass_len);

        for(k = 0; k < pass_len; k++)
                sk = sk + (((k % 256) ^ password[k]) ^ (rand() % 256));

        srand(sk);

        for(k = 0; k < str_len; k++)
                ret_val[k] = (rand() % 256) ^ str[k];

        ret_val[k] = 0;

        return ret_val;
}

---

[Edit]
Just to explain a little, the function is coded similarly to the VB one, except, it needs to know the length of the string especially when it needs to decrypt. This is because the encrypted string could contain NULL values, and strlen() would give an incorrect string length (the encrypted string is binary, not a string anymore). That's why it's not using strlen() to get the length of data for the str parameter, but it does use strlen() for getting the length of the password since it's always a NULL ended string.

neat thanks :D

do you know if this c++ function can decrypt a string encrypted by the vb6 function?

Quote:

---

Originally Posted by VaxoP

neat thanks :D

do you know if this c++ function can decrypt a string encrypted by the vb6 function?

---

I am at work now, so I cannot try it, but I'm pretty sure you can't.
Unless in the background VB6 uses the same C++ functions for random numbers, but I really doubt it.

hi im new to vb. can u teach me how to decrypt using ur code, and last thing
how do i use this code to display in my textbox3?

[vbcode] Debug.Print(Len(S), Len(Text2.Text), Asc(Mid(S, 36, 1)), Asc(Mid(S, 37, 1)))[/vbcode]

hi im new to vb. can u teach me how to decrypt using ur code, and last thing
how do i use this code to display in my textbox3?

Code:

---

Debug.Print(Len(S), Len(Text2.Text), Asc(Mid(S, 36, 1)), Asc(Mid(S, 37, 1)))

---

Quote:

---

Originally Posted by pohyf

hi im new to vb. can u teach me how to decrypt using ur code

---

To encrypt:
result = RndCrypt("string to encrypt", "password")

To decrypt
result = RndCrypt("string to decrypt", "password")

CVMichael,

After 10 months, I want to ask something about this useful code. I didn't understand how to displaying "decrypted strings" on a textbox.

1) I want to encrypt a text (with textbox and cmd),
2) send it database,
3) than decrypt it,
4) and show it in a textbox correctly.

I want to make a database protection, thats all. :)

I couldn't show the text in a textbox correctly. I think you answered it but I guess I missed the point. Please help me. :o

My second question is, is there any limitation about password character? For example, can I use 100 characters here? And how much is this important about protection?

When you encrypt, the result is binary data, therefore you have to encode it back to a string format, assuming that you want to hold the data into a text/varchar data type in the database.

You have to encode the encrypted string using Base64:
http://www.vbforums.com/showpost.php...53&postcount=4

Like this:
To encrypt:
plain_text = data from text box, file, etc.
Encrypted_string = Base64Encoding(RndCrypt(plain_text, "password"))
Store result in database = Encrypted_string

To decrypt:
Encrypted_string = Read from database
plain_text = RndCrypt(Base64Decoding(Encrypted_string), "password")


But I suggest that you use my improved version of the RndCrypt here:
VB6 - 31 Bit Encryption - To the Next Level

The encryption is stronger, you can even set how strong you want it to be (but it's still 31 bit), it just encrypts many times. And it also has Base64 integrated.

There is no limitation on the password length, and the longer the password, the better the encryption. This is true to any encryption...

Quote:

---

But I suggest that you use my improved version of the RndCrypt here:
VB6 - 31 Bit Encryption - To the Next Level

The encryption is stronger, you can even set how strong you want it to be (but it's still 31 bit), it just encrypts many times. And it also has Base64 integrated.

---

This is awesome! :) I am using it know. Thanks a lot! :)

And before I finish my post, I want to say that, "you are genius". :wave:

Hey CVMichael

I found a bug in your function RndCrypt.

================
This not working
================
Password: transcom
Text to encrypt: om

===========
This working
===========
Password: transcom
Text to encrypt: Om

RndCrypt Function return (first) character NUL ( dec: 0 Hex:0 Oct: 000 Char :NUL (null) )

Therefore the string is empty.

Otherwise nice code

// Best regards Pragma.

Actually... it's working fine...

If you put the encrypted string in a text box, then yes, it won't display the text because of the NULL(s). But YOU ARE NOT SUPPOSED to put binary data into a text box in the first place !!!

If you want to display binary data, then convert it to HEX, or Base64, so that the result is TEXT not binary.

This is a limitation of the text box control, not the encryption function.

You can do a simple test to prove that:

Code:

---

Dim EncStr As String

EncStr = RndCrypt("om", "transcom")

MsgBox RndCrypt(EncStr, "transcom")

---

Your text box will show "om", this means that the encrypted string WAS stored (and encrypted) properly.

Quote:

---

Originally Posted by CVMichael

Actually... it's working fine...

If you put the encrypted string in a text box, then yes, it won't display the text because of the NULL(s). But YOU ARE NOT SUPPOSED to put binary data into a text box in the first place !!!

If you want to display binary data, then convert it to HEX, or Base64, so that the result is TEXT not binary.

This is a limitation of the text box control, not the encryption function.

You can do a simple test to prove that:

Code:

---

Dim EncStr As String

EncStr = RndCrypt("om", "transcom")

MsgBox RndCrypt(EncStr, "transcom")

---

Your text box will show "om", this means that the encrypted string WAS stored (and encrypted) properly.

---

Hey

My bad sorry :)
I forgot to save/read file in binary mode.

// Best regards Pragma

Code:

---

Private Function AddByte(ByRef b As Byte, ByRef a As Byte) As Byte
        Dim c As Short = CShort(b) + CShort(a)
        If c > 255 Then
            Return CByte(c - 256)
        Else
            Return CByte(c)
        End If
    End Function

    Private Function TakeByte(ByRef b As Byte, ByRef a As Byte) As Byte
        Dim c As Short = CShort(b) - CShort(a)
        If c < 0 Then
            Return CByte(c + 256)
        Else
            Return CByte(c)
        End If
    End Function

    Private Function AddByteArray(ByRef b As Byte, ByRef a() As Byte) As Byte
        For i = 0 To a.Length - 1
            b = AddByte(b, a(i))
        Next

        Return b
    End Function

    Private Function TakeByteArray(ByRef b As Byte, ByRef a() As Byte) As Byte
        For i = 0 To a.Length - 1
            b = TakeByte(b, a(i))
        Next

        Return b
    End Function

    Private Function AddByteArray(ByRef a() As Byte, ByRef b As Byte) As Byte
        For i = 0 To a.Length - 1
            b = AddByte(a(i), b)
        Next

        Return b
    End Function

    Private Function TakeByteArray(ByRef a() As Byte, ByRef b As Byte) As Byte
        For i = 0 To a.Length - 1
            b = TakeByte(a(i), b)
        Next

        Return b
    End Function

    Public Function Encrypt_v2(ByRef stringValue As String) As String
        Return System.Text.Encoding.Default.GetChars(Encrypt_v2(System.Text.Encoding.Default.GetBytes(stringValue)))
    End Function

    Public Function Encrypt_v2(ByRef stringValue As String, ByRef passwordValue As String) As String
        Return System.Text.Encoding.Default.GetChars(Encrypt_v2(System.Text.Encoding.Default.GetBytes(stringValue), System.Text.Encoding.Default.GetBytes(passwordValue)))
    End Function

    Public Function Encrypt_v2(ByRef arrayBytes() As Byte) As Byte()
        ' we need to fill in a blank array.
        Dim RandomByteArray(arrayBytes.Length - 1) As Byte
        Dim ConstByteArray() As Byte = New Byte() {107, 68, 12, 99, 88, 100, 66, 14}
        Dim Result(arrayBytes.Length * 2 - 1) As Byte
        Dim x As Integer = -1

        r.NextBytes(RandomByteArray)

        For i = 0 To arrayBytes.Length - 1
            x += 1
            Result.SetValue(TakeByteArray(AddByte(arrayBytes(i), RandomByteArray(i)), ConstByteArray), x)
            x += 1
            Result.SetValue(TakeByteArray(RandomByteArray(i), ConstByteArray), x)
        Next

        Return Result
    End Function

    Public Function Encrypt_v2(ByRef arrayBytes() As Byte, ByRef passwordByte() As Byte) As Byte()
        ' we need to fill in a blank array.
        Dim RandomByteArray(arrayBytes.Length - 1) As Byte
        Dim Result(arrayBytes.Length * 2 - 1) As Byte
        Dim x As Integer = -1

        r.NextBytes(RandomByteArray)

        For i = 0 To arrayBytes.Length - 1
            x += 1
            Result.SetValue(TakeByteArray(AddByte(arrayBytes(i), RandomByteArray(i)), passwordByte), x)
            x += 1
            Result.SetValue(TakeByteArray(RandomByteArray(i), passwordByte), x)
        Next

        Return Result
    End Function

    Public Function Decrypt_v2(ByRef stringValue As String) As String
        Return System.Text.Encoding.Default.GetChars(Decrypt_v2(System.Text.Encoding.Default.GetBytes(stringValue)))
    End Function

    Public Function Decrypt_v2(ByRef stringValue As String, ByRef passwordValue As String) As String
        Return System.Text.Encoding.Default.GetChars(Decrypt_v2(System.Text.Encoding.Default.GetBytes(stringValue), System.Text.Encoding.Default.GetBytes(passwordValue)))
    End Function

    Public Function Decrypt_v2(ByRef arrayBytes() As Byte) As Byte()
        If arrayBytes.Length Mod 2 = 1 Then Return New Byte() {}
        Dim ConstByteArray() As Byte = New Byte() {107, 68, 12, 99, 88, 100, 66, 14}
        Dim Result(arrayBytes.Length * 0.5 - 1) As Byte
        Dim x As Integer = arrayBytes.Length - 1

        For i = Result.Length - 1 To 0 Step -1
            Result.SetValue(TakeByte(AddByteArray(ConstByteArray, arrayBytes(x - 1)), AddByteArray(ConstByteArray, arrayBytes(x))), i)
            x -= 2
        Next

        Return Result
    End Function

    Public Function Decrypt_v2(ByRef arrayBytes() As Byte, ByRef passwordByte() As Byte) As Byte()
        If arrayBytes.Length Mod 2 = 1 Then Return New Byte() {}
        Dim Result(arrayBytes.Length * 0.5 - 1) As Byte
        Dim x As Integer = arrayBytes.Length - 1

        For i = Result.Length - 1 To 0 Step -1
            Result.SetValue(TakeByte(AddByteArray(passwordByte, arrayBytes(x - 1)), AddByteArray(passwordByte, arrayBytes(x))), i)
            x -= 2
        Next

        Return Result
    End Function

---

I am flattered that you posted in my thread, but I fail to see what your code in .NET has anything to do with my 31 bit encryption?

PS. Welcome to VB Forums!

Quote:

---

Originally Posted by CVMichael

I am flattered that you posted in my thread, but I fail to see what your code in .NET has anything to do with my 31 bit encryption?

PS. Welcome to VB Forums!

---

Sorry I came to this forum from another website, (I searched VB.net Encryptions)