Enkódování/dekódování souboru

Postup:
Na formulář přidejte tlačítko a zapište do něj následující proceduru:

 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
       
        Randomize temp1
    Next x
       
   
    Counter = 0
    For z = 1 To FileLen(InputFile)
       
        XORMask = Int(Rnd * 256)
       
        Get 1, , Char
        Char = Chr$((Asc(Char) Xor XORMask))
        Put 2, , Char
       
        Counter = Counter + 1
        If Counter > Len(PasswordKey) Then Counter = 1
       
        For x = 1 To (Asc(Mid$(PasswordKey, Counter, 1)) * 2)
            temp = Rnd
        Next x
    Next z

    Close #1
    Close #2
   
End Sub

Na událost Click tlačítka zapište: 

Private Sub Command1_Click()

    Dim InputFile As String
    Dim OutputFile As String
    Dim PasswordKey As String
   
    InputFile = InputBox("Zadejte jméno souboru pro enkódování/dekódování")
    OutputFile = InputBox("Zadejte jméno nového souboru")
    PasswordKey = InputBox("Zadejte heslo")
   
    Call FileEncodeAndDecode(InputFile, OutputFile, PasswordKey)
   
    MsgBox "Soubor uložen jako " + OutputFile
    End

End Sub

Pro větší soubory může tento proces trvat i poměrně dlouho.

Zpět

Autor: The Bozena