Your Own Encryption Algorithm
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:
VB Code:
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:
VB Code:
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.
Re: Your Own Encryption Algorithm
Right then, this is the decrypt code.
VB 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.
Re: Your Own Encryption Algorithm
1) You never use storebinary in the encode routine, so get rid of it.
2) Change
VB Code:
For i = 1 To linecounter
Line Input #1, stringcounter
toThere'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.
Re: Your Own Encryption Algorithm
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.
Re: Your Own Encryption Algorithm
Verry good algorithm but i still say the hardest encryptions gotta be manualy giving each letter an encryption string.
example:
VB Code:
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
Re: Your Own Encryption Algorithm
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
Re: Your Own Encryption Algorithm
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. :thumb:
Re: Your Own Encryption Algorithm
Thats whats the forums here for.
Re: Your Own Encryption Algorithm
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.
Re: Your Own Encryption Algorithm
you ask for it, so here is the code to break this encryption :p
VB Code:
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.
Re: Your Own Encryption Algorithm
congratulations agilaz, nice code.
tho, to be fair, the final version won't give you the code to work from. :p
Re: Your Own Encryption Algorithm
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 ;)
Re: Your Own Encryption Algorithm
Who knows how the worlds best algorithm goes "cypherunicorn-A". Id like to see how they did it. :confused:
