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.