
                       If YOU ENCRYPT LARGE FILES PLEASE USE THE EnDeCryptSingle ROUTINE INSTEAD OF THE EnDeCrypt ROUTINE OR SPLIT THE INPUT IN SMALLER PIECES!
                       '
                       'This code is copyrighted and has' limited warranties.Please see http://w
                       '     ww.Planet-Source-Code.com/xq/ASP/txtCode
                       '     Id.1736/lngWId.1/qx/vb/scripts/ShowCode.
                       '     htm'for details.'**************************************

                       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 fi
                       '     le 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 fi
                           '     le


                           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 fi
                           '     le


                           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
