Your Own Encryption Algorithm

[kazar]

Hey,

A while back i needed to write an encryption algorithm, and came up with the following. Note, the encryption is blisteringly fast, it can encrypt a 1 MB file in about 4 seconds, but to decrypt it takes about 60.

This code works by getting the contents of a file in binary, and then multiplying, adding, etc using random numbers as well, as an Encryption String and Number. The result is then outputted to a file. As far as i can tell, this is pretty tough encryption, especially since you need both the string and number to decrypt it.


Som neccessary declarations:

Option Explicit
Dim encodestring As String
Dim encodenumber As Long
Dim i As Long
Dim linecounter As Long
Dim stringcounter As String
Dim Y As Long
Dim currentencode As Long
Dim endline As Long
Dim swapnumber As Integer
Dim storebinary(10000000) As Long
Dim counter As Long
Dim charactercount As Long
Dim stepcount As Long
Dim currentchar As Long

This is the encryption code itself:

Sub Encrypt(sourcefile As String, destfile As String, encryptionkey As String, encryptionnumber As Long)
 
On Error GoTo filerror
Open sourcefile For Input As #1
 
On Error GoTo skipall
encodestring = encryptionstring
If encodestring = "" Then GoTo skipall
 
swapnumber = encryptionnumber
If swapnumber = 0 Then GoTo skipall
encodenumber = 0
 
    For i = 1 To Len(encodestring)
         encodenumber = encodenumber + Asc(Mid(encodestring, i, 1))
     Next i
 On Error GoTo fileskip
 
On Error GoTo fileskip
Do Until EOF(1) = True
            Line Input #1, stringcounter
            linecounter = linecounter + 1
Loop
 
fileskip:
Err = 0
On Error GoTo skipall
Close
 
Open sourcefile For Input As #1
    Close #2
    On Error GoTo filecloser
    Open destfile For Output As #2
    On Error GoTo skipall
        Print #2, ""
    Close #2
    Open destfile For Binary As #2
    
            
                On Error Resume Next
                For i = 1 To linecounter
                    
                    Line Input #1, stringcounter
                        For Y = 1 To Len(stringcounter)
                            
                            currentencode = ((Asc(Mid(stringcounter, Y, 1)) + encodenumber) * swapnumber)
                            Put #2, , currentencode
                            charactercount = charactercount + 1
                            
                           
                        Next Y
                     endline = 9999
                     Put #2, , endline
                Next i
              On Error GoTo skipall
Close
For i = 1 To 1000000
    storebinary(i) = 0
Next i
counter = 1
 
MsgBox "Encryption Complete", vbDefaultButton1, "Encrypted"
GoTo skipall
filecloser:
Close
GoTo skipall
filerror:
MsgBox "File Error Detected", vbCritical, "File Error"
Err = 0
skipall:
If Err <> 0 Then
MsgBox "Error Encountered: " + Err.Description, vbCritical, "Error"
End If
Close
 
 
End Sub

The decryption is in the next post.

[kazar]

Right then, this is the decrypt code.

Private Sub Decrypt(sourcefile As String, destfile As String, encryptionkey As String, encryptionnumber As Long)
 
 
 
Close
encodestring = encryptionkey
If encodestring = "" Then GoTo skipall
 
swapnumber = encryptionnumber
 
If swapnumber = 0 Then GoTo skipall
 
Open sourcefile For Binary As #1
 
charactercount = 1
 
 
Do Until EOF(1) = True
Get #1, , storebinary(charactercount)
charactercount = charactercount + 1
Loop
 
Close #1
encodenumber = 0
    For i = 1 To Len(encodestring)
         encodenumber = encodenumber + Asc(Mid(encodestring, i, 1))
     Next i
 
Open destfile For Output As #1
status_label.Caption = "Decrypting and Exporting to File"
    On Error Resume Next
    For i = 1 To charactercount
        
        currentchar = storebinary(i)
        
        If currentchar = 9999 Then
        Print #1, ""
        
        GoTo skipthis
        End If
        
        currentchar = currentchar / swapnumber
        currentchar = currentchar - encodenumber
       
        
         Print #1, Chr(currentchar);
        
         
         Me.Refresh
skipthis:
Err = 0
    Next i
 Close
 
MsgBox "Decryption Complete", vbDefaultButton1, "Decrypted"
GoTo skipall
 
filerror:
MsgBox "File Error Detected", vbCritical, "File Error"
Err = 0
skipall:
If Err <> 0 Then
MsgBox "Error Encountered", vbCritical, "Error"
End If
Close
 
End Sub

This is to be fair, not the most brilliant code in the world, and i would appreciate any suggestions for improvement.

[Al42]

1) You never use storebinary in the encode routine, so get rid of it.
2) Change

For i = 1 To linecounter
Line Input #1, stringcounter

to

Do Until EOF(1)

There's no reason to read through the file twice. (And there's no reason to test whether a binary is true twice - if <binary> and if <binary> = true yield the same result. [EOF() returns True or False].)

Same thing in the decode routine - open the file as binary and read the bytes until EOF - no need to read them into an array first - and you can get rid of the array.

Oh - and you have "On Error GoTo fileskip" twice in the encode routine, one right after the other.

[kazar]

Thanks AL42, i'll change the eof thing and get rid of some useless code. btw, if you can break it, tell me, i am working on ways to better the encryption algorithm.

[g4hsean]

Verry good algorithm but i still say the hardest encryptions gotta be manualy giving each letter an encryption string.
example:

With Text1
If .text = "A" Then
.text = "9021079"
End If

it took me a day to do and damn i swear no one could break the file encryption on it unless they had my program and a couple of dissasembling tool's.I've sent it to Mozzila and they really got a kick out of it and they asked if they could use it on an upcoming experimental program

[kazar]

however, as security goes it's pretty poor, i mean, the code never changes. So if someone has a file encrypted with your algorithm, that they know the clear text of, then they know the value of every single letter in your algorithm. If it doesn't change the algorithm every times it runs, it's pretty weak. Not only that, but u have no way of securing the file. Mine requires two codes which govern decryption and encryption. That means that only people with both codes can decrypt the file, not just someone with a copy of ur program

[g4hsean]

That is darn true i thank you for pointing that out for me. Ok im going to go hard at work and build an algorithm. It all makes sense now lol.

[kazar]

Thats whats the forums here for.

[JimSok]

I'm a complete greeney to VB, but wanted to add 2-whole-cents worth to the general idea of building your own encryption/decryption algorithm. My previous software is in another, incompatible language (a 4GL), but here's two things I do there that make it better....

1) It's often nice to map only "printable" ASCII characters to other "printable" ASCII characters. Since they have a contiguous block of byte values, this is easy by subtracting the minimum number and MOD-ing by the total number of printable characters....

2) Shuffle the string before (and of course after) encryption. In other words....
(a) take characters from the back forward
(b) take characters from the middle outwards....
(c) or any other unique shuffling mechanism....

These both work great for the licensing and "fueling" utilities I've built - and must now rebuild in VB - for all my software products.

[Agilaz]

you ask for it, so here is the code to break this encryption

Private Sub bforce()
    Dim ff As Integer, tlong As Long, x As Long, Y As Long, tchar As Single, z As Long
    Dim bdata() As Long, cdata() As Long, arrdim As Long
    Dim found As Boolean, cnt As Long
    
    Const maxkeylength As Long = 10
    
    ff = FreeFile
    
    Open App.Path & "\ecrypted.txt" For Binary As #ff
 
    Do
        Get #ff, , tlong
    Loop Until tlong <> 9999
    
    
    arrdim = 10000
    ReDim bdata(arrdim)
    ReDim cdata(arrdim)
 
    For x = 0 To 255
        For Y = 1 To (255 * maxkeylength) + 255
            tchar = tlong / (x + Y)
            If tchar = Fix(tchar) Then
                found = False
                For z = 0 To cnt
                    If bdata(z) = tchar And cdata(z) = Y Then
                        found = True
                        Exit For
                    End If
                Next z
                If found = False Then
                    bdata(cnt) = CLng(tchar)
                    cdata(cnt) = Y
                    cnt = cnt + 1
                    If cnt > arrdim Then
                        arrdim = arrdim + 10000
                        ReDim Preserve bdata(arrdim)
                        ReDim Preserve cdata(arrdim)
                    End If
                End If
            End If
        Next Y
    Next x
    ReDim Preserve bdata(cnt - 1)
    ReDim Preserve cdata(cnt - 1)
 
    Do While cnt > 1 And Not EOF(ff)
        Get #ff, , tlong
        cnt = 0
        For x = 0 To UBound(bdata)
            If bdata(x) <> 0 And tlong > 0 And tlong <> 9999 Then
                tchar = (tlong / bdata(x)) - cdata(x)
                If tchar = Fix(tchar) And tchar > -1 And tchar < 256 Then
                    cnt = cnt + 1
                Else
                    bdata(x) = 0
                    cdata(x) = 0
                End If
            End If
        Next x
        If cnt < 256 Then Exit Do
    Loop
    Close #ff
    Dim swapnumber() As Long
    Dim encodenumber() As Long
    
    cnt = 0
    For z = 0 To UBound(bdata)
        If bdata(z) <> 0 Then
            ReDim Preserve encodenumber(cnt)
            ReDim Preserve swapnumber(cnt)
            swapnumber(cnt) = bdata(z)
            encodenumber(cnt) = cdata(z)
            cnt = cnt + 1
        End If
    Next z
    
End Sub

this procedure takes just a minute to create possible swapnumber/encodenumber combinations. most often less then 255 pairs which always contain the right combination.

note that you don't need the password for decryption if you have the decryption code.

the method to create the encodenumber from the password is weak. there are a lot of possible crypto collisions.
for example the password abcd1234 results in the same encodenumber as 4a3b2c1d or 1234dcba etc.

but even if you change that method...the encryption algo is still the same.

i hope this will give you some ideas to create a better algo.

[kazar]

congratulations agilaz, nice code.

tho, to be fair, the final version won't give you the code to work from.

[Agilaz]

IMHO an encryption algo is only good if you can't break it even if you have the source code. programs can be disassembled and reverse engineered.
btw...the best encrpytion algos like Blowfish, Rijndael, Twofish and others are open source

[g4hsean]

Who knows how the worlds best algorithm goes "cypherunicorn-A". Id like to see how they did it.