Encode/Decode File Using Password

Enter file source name, file destination name, and password. this code will copy the source file to the destination file name. If the source file was not encrypted, the destination file will be encrypted. If the source file was encrypted, the destination file will be the former file before the encryption.


Add 1 Command Button named Command1.

Form Code

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 thr filename to encode/decode")
    OutputFile = InputBox("Enter the new filename this file will become ")
    PasswordKey = InputBox("Enter the password")
    Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey)
    MsgBox "File written to " + OutputFile
End Sub

Go Back