Code Snippets

Visual Basic Source Code

Welcome to Dream.In.Code
	Become a VB Expert! Join 244,275 VB Programmers for FREE! Get instant access to thousands of VB experts, tutorials, code snippets, and more! There are 1,166 people online right now. Registration is fast and FREE... Join Now! Chat LIVE With a VB Expert

Encrypt-Decrypt File with Password

Encryption and Decryption of any file with a password.

Submitted By: Nitish4uall

Actions:

Rating:

Views: 12,429

Language: Visual Basic

Last Modified: May 26, 2006

Instructions: 'Add a CoommandButton - Command1

'Just Run and select click the button to see the action.

Snippet

Sub FileEncodeAndDecode(InputFile As String, OutputFile As String, PasswordKey As String)
Dim temp As Single
Dim Char As String * 1
Dim XORMask As Single
Dim temp1 As Integer
Open InputFile For Binary As #1
Open OutputFile For Binary As #2
For x = 1 To Len(PasswordKey)
temp = Asc(Mid$(PasswordKey, x, 1))
For y = 1 To temp
temp1 = Rnd
Next y
' Re-seed to throw off prying eyes
Randomize temp1
Next x
Counter = 0
For z = 1 To FileLen(InputFile)
'Generate random mask
XORMask = Int(Rnd * 256)
'Get the char & change it
Get 1, , Char
Char = Chr$((Asc(Char) Xor XORMask))
Put 2, , Char
Counter = Counter + 1
If Counter > Len(PasswordKey) Then Counter = 1
' Pull random numbers from the hat
For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2)
temp = Rnd
Next x
Next z
Close #1
Close #2
End Sub
Private Sub Command1_Click()
Dim InputFile As String
Dim OutputFile As String
Dim PasswordKey As String
InputFile = InputBox("Enter a filename to encode")
OutputFile = InputBox("Enter the new filename this will become ")
PasswordKey = InputBox("Enter the password (key)")
Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey)
MsgBox "File written to " + OutputFile
End
End Sub
Private Sub Form_Load()
Command1.Caption = "Code/Decode"
End Sub

Copy & Paste

Sub FileEncodeAndDecode(InputFile As String, OutputFile As String, PasswordKey As String)
    
    Dim temp As Single
    Dim Char As String * 1
    Dim XORMask As Single
    Dim temp1 As Integer
    
    Open InputFile For Binary As #1
    Open OutputFile For Binary As #2
    
    For x = 1 To Len(PasswordKey)
        temp = Asc(Mid$(PasswordKey, x, 1))
        For y = 1 To temp
            temp1 = Rnd
        Next y
        
        ' Re-seed to throw off prying eyes
        Randomize temp1
    Next x
        
    
    Counter = 0
    For z = 1 To FileLen(InputFile)
        
        'Generate random mask
        XORMask = Int(Rnd * 256)
        
        'Get the char & change it
        Get 1, , Char
        Char = Chr$((Asc(Char) Xor XORMask))
        Put 2, , Char
        
        Counter = Counter + 1
        If Counter > Len(PasswordKey) Then Counter = 1
        
        ' Pull random numbers from the hat
        For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2)
            temp = Rnd
        Next x
    Next z

Close #1
    Close #2
    
End Sub

Private Sub Command1_Click()

Dim InputFile As String
    Dim OutputFile As String
    Dim PasswordKey As String
    
    InputFile = InputBox("Enter a filename to encode")
    OutputFile = InputBox("Enter the new filename this will         become ")
    PasswordKey = InputBox("Enter the password (key)")
    
    Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey)
    
    MsgBox "File written to " + OutputFile
    End
End Sub

Private Sub Form_Load()

Command1.Caption = "Code/Decode"

End Sub