(Update) RC4 Stream Cipher (with file handling )
This code offers you a strong encryption with RC4. I've tested it a lot and it's the right implementation of the RC4 cipher.
'You can use this code in your commercial code because it's not patented!
'I know there is another code that deals with RC4 but my code has nothing to do with this code!
'More infos: sci.crypt
Original Author: Sebastian
Inputs
Create the form and simply select a file to en(de)crypt!
'Notice that you use the same function for encryption and decryption
Assumptions
'Assumes:Create a form with:
'
'txtpwd (txtbox)
'txtSave (txtbox)
'txtPattern (Combobox)
'filList (FileListBox)
'DirList (DirListBox)
'drvList (DrvlistBox)
'Command1 (Command Button ; Caption=Encrypt)
'Command2 (Command Button ; Caption=Decrypt)
Returns
After you press the Button you should get the en(de)crypted file!
Side Effects
If you encrypt different textes with the same password, someone could be able to decrypt your code. (This is quiet normal for a stream cipher!)
IF YOU ENCRYPT LARGE FILES PLEASE USE THE EnDeCryptSingle ROUTINE INSTEAD OF THE EnDeCrypt ROUTINE OR SPLIT THE INPUT IN SMALLER PIECES!
Code
Option Explicit
Dim s(0 To 255) As Integer 'S-Box
Dim kep(0 To 255) As Integer
Dim i As Integer, j As Integer
'For the file actions
Dim path As String
Public Sub RC4ini(Pwd As String)
Dim temp As Integer, a As Integer, b As Integer
'Save Password in Byte-Array
b = 0
For a = 0 To 255
b = b + 1
If b > Len(Pwd) Then
b = 1
End If
kep(a) = Asc(Mid$(Pwd, b, 1))
Next a
'INI S-Box
For a = 0 To 255
s(a) = a
Next a
b = 0
For a = 0 To 255
b = (b + s(a) + kep(a)) Mod 256
' Swap( S(i),S(j) )
temp = s(a)
s(a) = s(b)
s(b) = temp
Next a
End Sub
'Only use this routine for short texts
Public Function EnDeCrypt(plaintxt As Variant) As Variant
Dim temp As Integer, a As Long, i As Integer, j As Integer, k As Integer
Dim cipherby As Byte, cipher As Variant
For a = 1 To Len(plaintxt)
i = (i + 1) Mod 256
j = (j + s(i)) Mod 256
' Swap( S(i),S(j) )
temp = s(i)
s(i) = s(j)
s(j) = temp
'Generate Keybyte k
k = s((s(i) + s(j)) Mod 256)
'Plaintextbyte xor Keybyte
cipherby = Asc(Mid$(plaintxt, a, 1)) Xor k
cipher = cipher & Chr(cipherby)
Next a
EnDeCrypt = cipher
End Function
'Use this routine for really huge files
Public Function EnDeCryptSingle(plainbyte As Byte) As Byte
Dim temp As Integer, k As Integer
Dim cipherby As Byte
i = (i + 1) Mod 256
j = (j + s(i)) Mod 256
' Swap( S(i),S(j) )
temp = s(i)
s(i) = s(j)
s(j) = temp
'Generate Keybyte k
k = s((s(i) + s(j)) Mod 256)
'Plaintextbyte xor Keybyte
cipherby = plainbyte Xor k
EnDeCryptSingle = cipherby
End Function
'************This section handles the file actions*****************
Private Sub DirList_Change()
filList.path = Dirlist.path
End Sub
Private Sub drvList_Change()
On Error GoTo DriveHandler
Dirlist.path = drvList.Drive
Exit Sub
DriveHandler:
drvList.Drive = Dirlist.path
Exit Sub
End Sub
Private Sub filList_Click()
txtSave.Text = filList.List(filList.ListIndex)
End Sub
Private Sub Form_Load()
txtPatter.AddItem "*.*", 0
txtPatter.AddItem "*.txt", 1
filList.Pattern = txtPatter.Text
End Sub
Private Sub txtPatter_Change()
filList.Pattern = txtPatter.Text
End Sub
Private Sub txtPatter_Click()
filList.Pattern = txtPatter.Text
End Sub
'************* Encrypten Routine ******************
Private Sub Command1_Click()
Dim inbyte As Byte
Dim z As Long
'Set the Set-Box Counter zero
i = 0: j = 0
'Ini the S-Boxes only once for a hole file
If txtpwd.Text = "" Then
MsgBox "You need to enter a password for encrypten or decrypten"
Exit Sub
Else
RC4ini (txtpwd.Text)
End If
'Disable the Mousepointer
MousePointer = vbHourglass
path = Dirlist.path + "" + txtSave
Open path For Binary As 1
Open path + ".enc" For Binary As 2
For z = 1 To LOF(1)
Get #1, , inbyte
Put #2, , EnDeCryptSingle(inbyte)
Next z
Close 1
Close 2
'Enable the Mousepointer
MousePointer = vbDefault
End Sub
'*********** Decryptenroutine ***********
Private Sub Command2_Click()
Dim inbyte As Byte
Dim z As Long
'Set the Set-Box counter zero
i = 0: j = 0
'Ini the S-Boxes only once for a hole file
If txtpwd.Text = "" Then
MsgBox "You need to enter a password for encrypten or decrypten"
Exit Sub
Else
RC4ini (txtpwd.Text)
End If
'Disable the Mousepointer
MousePointer = vbHourglass
path = Dirlist.path + "" + txtSave
Open path For Binary As 1
path = Left$(path, Len(path) - 4)
Open path For Binary As 2
For z = 1 To LOF(1)
Get #1, , inbyte
Put #2, , EnDeCryptSingle(inbyte)
Next
Close 1
Close 2
'Enable the Mousepointer
MousePointer = vbDefault
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.